己解決
原来可以先定义数组的大小，再来做
3 A* j# u9 [, i4 F6 {: u0 T以下是我的做法。
3 X9 R( W( G/ n$ I% j+ F. P/ ^, N/ }4 r+ |0 h9 m Q$ k- B5 j
是用来比较两个excel文件的，且将新的生成一个工作表。
; G3 X/ K8 x, E F! E. V$ K写得很乱。不好意思
/ x* z0 G1 b! M; G% g% G& H. E2 b, x! Y: z R1 O/ S
1 V# w5 h; L, s- x) V# V/ ?2 n/ ]+ b
Option Explicit '强制声明变量8 I- |# m/ n( ~1 _) c, F: y
Dim array_s() '定义动态数组, N8 {+ U0 s3 @: n: k
Dim array_d()
' t4 ^& \/ B h( C3 sDim sourfile,destfile,objexcel,objworkbook_s,objworkbook_d,objworksheet_s,objworksheet_d,objworksheet_d2! K& k& ~2 V: D% \' f% s, H
Dim introw_s,introw_d,intcol_s,intcol_d) T0 }; Z0 a% }/ \' f# J
Dim i,j,h,k; P7 i2 M; @; ?! ^: |
Dim fs,ext* X+ \. U2 W8 z
% E5 [, f E* U7 C7 T' g'*********************************4 k& q/ t8 C, i0 e s$ P7 Y* Z+ H
'* Choice Dimission Excel File *
. G1 S" ^2 m* K1 M'*********************************
: z* }7 h# B7 i5 G1 r6 y5 A% QSet fs=CreateObject("scripting.filesystemobject")6 C+ `% ]+ B5 m0 j) ]9 Y, E
sourfile=openfile("请选择文件：","c:\","everything|*.*|excel-documents|*.xls|text files|*.txt|word-documents|*.doc",2,0)
1 W; j7 R1 e3 S+ U7 H. r2 vext=LCase(fs.GetExtensionName(sourfile))- Y/ q9 A! A9 U5 n( H1 @% [8 `
'MsgBox ("文件扩展名是：" & ext )$ b# k) Y$ p% Y8 I5 q, n
If Not ext="xls" Then
; F, ]% n! ?/ L9 \) ^MsgBox "你选择的文件类型不对，请选择EXCEL文件！"
% v9 u6 M- g5 z2 ~5 _WScript.Quit
* W2 Z# L) ]9 S" zEnd if7 X. Q0 Z2 j$ Y. l6 T- L
MsgBox "你选择的文件是：" &sourfile 'dimission
. {/ w; {# y' n. Q
: { d( f. U5 f, b7 V. m/ `% ?'******************************- a! C+ k5 }3 K
'* Choice On-job Excel File *- k; C8 F/ E: d: j: P
'******************************# Q1 |, \6 i! _( [! ], V0 ]
Set fs=CreateObject("scripting.filesystemobject"): c6 x! L/ o/ ^, G" G# j
destfile=openfile("请选择文件：","c:\","everything|*.*|excel-documents|*.xls|text files|*.txt|word-documents|*.doc",2,0) U6 Q6 B. C- M3 O
ext=LCase(fs.GetExtensionName(destfile))
: f4 F2 Q A( x8 V'MsgBox ext1 r; y2 ^; v" e4 `
If Not ext="xls" Then+ z! D' r* Q, ?" x! y
MsgBox "你选择的文件类型不对，请选择EXCEL文件！": o# s* }% e' Z: e
WScript.Quit5 o+ O Y5 s3 b% m
End If
3 y0 q6 ~9 L* }) H& J
- W0 w1 O( G$ v$ O) @% r- FMsgBox "你选择的文件是：" &destfile 'in-job3 Z3 A* J" B( u$ |0 i* X c
0 d. E' z- e4 P& ]5 z# PSet objexcel=CreateObject("excel.application")
6 o' t! V: `2 ]! ~
/ ]& u' G1 c- h# Q( q) U'*******************************
# x) E# G! I6 `5 c5 X'* Dimission File to Array *
9 Z: B4 o, S0 U n6 @'*******************************
^9 I" T1 [/ x" ~3 j% s* b8 jobjexcel.Visible=True
, J) T3 n. Q3 O! B- |) D: r6 GSet objworkbook_s=objexcel.Workbooks.Open(sourfile)+ _2 h8 a( U1 j3 [& G& l
Set objworksheet_s=objworkbook_s.Worksheets(1)
* M5 y" m: H$ z. Dintrow_s=1. t: @- V. H0 [ A" F' ~
intcol_s=1# u3 H- |6 C6 n
Do Until objworksheet_s.cells(introw_s,1)="" '得到行数7 P% `4 U$ i$ c+ E
introw_s=introw_s+1
- S' ^- f) E# S0 \Loop
" n6 c1 s$ M/ n! t
, z; B6 l0 q$ W' {# V& k( rDo Until objworksheet_s.cells(2,intcol_s)="" '得到列数2 s% e( h* j$ V+ m9 L
intcol_s=intcol_s+17 b' N3 Z0 D2 `8 z _
Loop" m! i \* T( k& `) p! s% O
- a( [ n1 D, TReDim Preserve arr_s(introw_s-2,intcol_s-2) '定义数组
4 r, M+ c9 f9 x# ^; w2 Ni=2
' F6 X$ t) @' t* E) Oj=1
9 q0 n# n) }$ N8 nDo Until objworksheet_s.cells(i,1)=""! G8 V* J" y5 b( N: o# `
For j=1 To intcol_s-1$ n. ?: R1 l3 h7 \9 }. J
arr_s(i-2,j-1)=objworksheet_s.cells(i,j)& ^+ H1 V6 W' `1 h9 {. b
Next
/ R: K& t& h6 z# w3 y/ R$ m: A: N i=i+1
& R: O; L0 r& S& i6 ?4 T j=1
( N2 y8 Z$ r) j1 ^3 G9 MLoop
. d# Z" _% Y7 r# Q. M1 Q7 O- m) K6 W1 E( w$ O9 G1 h
'****************************
3 [' s3 F$ |- ?0 I3 n'* On-job File to Array *+ P0 V1 `+ a1 }: O+ R' ]2 A
'****************************
0 N& }4 t6 y' C8 y* L8 u0 h1 kobjexcel.Visible=True' f* q2 h Z7 e% v) z, ?
Set objworkbook_d=objexcel.Workbooks.Open(destfile)! r# A |# O3 t, C( b
Set objworksheet_d=objworkbook_d.Worksheets(1)
# u* e: y1 `2 Q- }% ~4 hintrow_d=1
% Z$ J( n( R/ O: z2 m. wintcol_d=1
7 P! z) v; Z5 p. z9 S4 {Do Until objworksheet_d.cells(introw_d,1)="" '得到行数- U# }; z& o8 y% ~% Q4 G6 C& S0 e
introw_d=introw_d+1
: W* m6 x. x/ {2 ~, a8 FLoop
/ X6 K; z1 _, E/ u7 ?9 z+ y
6 ^ R+ L( d4 {3 K- ADo Until objworksheet_d.cells(2,intcol_d)="" '得到列数/ M* c5 t- b0 g Z+ J/ f6 r' e
intcol_d=intcol_d+1 N6 \ T( D' t$ o$ H6 T
Loop J. W# f5 E" [' k) n
J; E' F8 b4 s+ r/ t6 a
ReDim Preserve arr_d(introw_d-2,intcol_d-2) '定义数组0 c# @$ i R, X. d. L& r
h=2
) r3 e) C' v4 u% Q5 ~k=1
9 {: Z% G5 J0 d8 ~Do Until objworksheet_d.cells(h,1)=""' U6 X# d3 B4 R( G8 ~
For k=1 To intcol_d-1
& N8 @5 r" d3 r) c/ L arr_d(h-2,k-1)=objworksheet_d.cells(h,k)
3 m+ [4 Y& X/ ~1 m1 m) u Next
6 k5 _, E* M& ]. p h=h+1& D( ]# ?3 D1 G. i- ^# ^5 N
k=1
2 u! J9 U7 X D7 dLoop
' x/ h8 |6 J) o' |" a' S- i, i; X" z
'*******************************************' M9 d( m( N3 `+ {
'* Compare Array and Mark The Same Record *& w( Q3 `( }% ?$ b) O
'******************************************** c1 U& ~1 r" B6 i
introw_s=0# B5 `+ }; R3 R1 T# a; o# L
introw_d=0
( e. x8 }4 I! O0 [6 ]7 Uintcol_s=05 w: }# t0 U( l8 t* H% C1 y
intcol_d=0
3 K5 m( S7 j' O: F4 }Do Until arr_s(introw_s,1)=""
6 n: n V9 T0 b- y For introw_d=0 To UBound(arr_d,1)6 j+ U4 ~6 S4 q) R" s8 y0 Q
'If CStr(arr_s(introw_s,2))=CStr(arr_d(introw_d,1)) Then/ ]& H. u1 D8 D. v7 }5 t
If arr_s(introw_s,2)=arr_d(introw_d,1) Then( g' a* R6 W2 U
MsgBox arr_s(introw_s,2)) L3 q& h2 @" O& i; `* C! X
objworksheet_d.cells(introw_d+2,6)=1 '在相同的记录后面写入1
% o, D+ x' c+ z- t v6 \ End if
: L- d! e, K- u$ ?5 Z) M Next
* ?2 Z- [+ c1 t' R& D3 ~1 q; M introw_s=introw_s+1
+ {3 T. Y% k4 G0 PLoop
8 B1 X5 B5 u, V: q. E, u9 P* l' e' U$ G
'********************************, |8 w- h p- y) d
'* Create Outgoing User List *9 q7 ]# ~1 S5 G, l1 G' S
'********************************7 } P% o! L; `/ ^
introw_d=1
$ d- O2 i* M3 `5 m% `' \3 hintcol_d=2
! s3 @( L4 p9 H5 aSet objworksheet_d2=objworkbook_d.Worksheets(2)* R. D6 x" g* ~' g' ^
Do Until objworksheet_d.cells(introw_d,1)="", c+ S9 n% M2 Z- p9 P
If objworksheet_d.cells(introw_d,6)=1 Then
5 h# U: P" B0 x7 @2 Y& ] objworksheet_d2.cells(intcol_d,1).value=objworksheet_d.cells(introw_d,1).value
( \" j. W: Z- N- A ' MsgBox objworksheet_d2.cell(intcol_d,1)
% s+ o. c& G" T objworksheet_d2.cells(intcol_d,2)=objworksheet_d.cells(introw_d,2).value
" b& k ^% u/ ~ objworksheet_d2.cells(intcol_d,3)=objworksheet_d.cells(introw_d,3).value. D) ^8 w% j) d% G% s) }
objworksheet_d2.cells(intcol_d,4)=objworksheet_d.cells(introw_d,4).value
8 `/ |2 T$ Y8 }8 b/ x6 ` objworksheet_d2.cells(intcol_d,5)=objworksheet_d.cells(introw_d,5).value. I( c5 }/ @. v/ `) p4 c
intcol_d=intcol_d+1" s8 z9 v# [& ~
End If
3 y( n) X I! r9 e introw_d=introw_d+1
1 s/ Y# L) Q8 m5 n& Rloop
, N. l, B$ Y" i ]/ H
% ?, a+ v* q) M r% E0 F; ~5 Z) a0 L1 t; R" \& t# X
objexcel.Save
$ w1 D# ]; u: J; ~; b* v7 Bobjexcel.quit! m8 b o) b( E$ a
# M. f% }' {. R2 Z/ l+ x) b( `7 v5 c'*************************9 B2 v3 @: P" h+ E& c3 W
'* Function openfile *8 A _+ C6 T9 D0 I! a. \3 m7 P' A
'*************************+ D( h! W w* u3 {
Function openfile(title,dir,Filter,index,flags) 'dir打开的路径，filter档案的类型及种类?3 v" v- Y( t) D! j3 M7 C- V. R q
Dim comdlg7 m0 Z7 E& b, R2 x5 V8 G( M `
Set comdlg=CreateObject("mscomdlg.commondialog")
1 {; p& r, J7 C9 a4 H If Filter="" Then
% _2 S l N& h1 m$ O3 p Filter="all files|*.*"& F, c; O0 w) W3 R3 d9 v
End If% E3 P/ _7 A0 l2 {6 H
" Y9 R9 f$ O( U; T comdlg.filter=Filter2 i! M' \, j3 Q% l2 S: U/ W, j
comdlg.FilterIndex=index5 w0 [, {) ?, D3 ]: Q7 S7 q
comdlg.Flags=flags
6 J6 w$ f) [& ^+ t% Y8 e comdlg.MaxFileSize=260
7 t* o# k( B' U comdlg.CancelError=False
; p% [ q ]" B3 Z2 |' N comdlg.DialogTitle=title
" k Z& Y0 y5 Z- t4 G2 Z comdlg.InitDir=dir
% F8 x- z% b7 b - f- b. p# e* w; x
comdlg.ShowOpen1 z6 x. R: r i5 a" d* w+ B
openfile=comdlg.FileName9 L/ t! r, L9 C$ p; @+ ~. P
End Function( ~2 R8 Y- I) d+ ?. W
. F1 {4 ]1 r0 b: y# u
[ 本帖最后由 a_che000 于 2007-7-13 17:12 编辑 ]
