作者fri13 (做个自己喜欢的人)
看板Visual_Basic
标题Re: [VBA ] 小弟我想不出来怎麽写了
时间Tue Mar 21 10:14:11 2006
小弟我目前写成这样了
但是还怪怪的
还剩一个主要的问题还没解
资料大小的判断
不知道哪位前辈可以帮忙给点意见的
多谢
Sub Macro1()
'比对程式需求有:
'Excel 分成 A、B 两个档，每个档案内有1、2、3 三个 Sheet。
'所以一共有六组 → A1、A2、A3、B1、B2、B3。
'动作(一) 比对A1 vs. B1的内容
'A栏 → 项次比对：A1 Yes； B1No 为『消失』。
'A栏 → 项次比对：A1 No； B1Yes 为『新增』。
'E栏 → 数目比对：A1、B1皆为 Yes，但 E栏有变动。
'F栏 → 金额比对：A1、B1皆为 Yes，但 F 栏有变动。'
'动作
'(二) 比对A2 vs. B2的内容 ～ 5. 动作同上
'动作
'(三) 比对A3 vs. B3的内容 ～ 5. 动作同上
Dim temp(20, 3, 3)
Workbooks.Open Filename:="b.xls"
Set book_b = Workbooks("b.xls")
rowpos = 1
colpos = 1
For rowpos = 1 To 20
'比对 a1 b1 及a2 b2 a3 b3
For i = 1 To 3
'比对a栏
flag = 0
colpos = 1
If ThisWorkbook.Worksheets(i).Cells(rowpos, colpos) = "" Then
If book_b.Worksheets(i).Cells(rowpos, colpos) <> "" Then
temp(rowpos - 1, 0, i - 1) = "新增"
End If
Else
If book_b.Worksheets(i).Cells(rowpos, colpos) = "" Then
temp(rowpos - 1, 0, i - 1) = "消失"
Else
flag = 1
End If
End If
colpow = 5
If ThisWorkbook.Worksheets(i).Cells(rowpos, colpos) <>
book_b.Worksheets(i).Cells(rowpos, colpos) And flag = 1 Then
temp(rowpos - 1, 1, i - 1) = "更动"
End If
colpow = 6
If ThisWorkbook.Worksheets(i).Cells(rowpos, colpos) <>
book_b.Worksheets(i).Cells(rowpos, colpos) And flag = 1 Then
temp(rowpos - 1, 2, i - 1) = "更动"
End If
Next
Next
Dim newbook(3)
Set newbook(3) = Workbooks.Add
'Set newbook2 = Workbooks.Add
'Set newbook3 = Workbooks.Add
'写入档案
'输出需求：
'在同一个目录下新增三个Excel (档名同1、2、3 三个 Sheet)
'档名1，放入动作(一)的比对结果
'Sheet 1 放入A栏 项次比对：A1 Yes； B1No 的结果，Sheet 名称为『消失项次』
'Sheet 2 放入A栏 项次比对：A1 No； B1Yes 的结果，Sheet 名称为『新增项次』
'Sheet 3 放入E栏 数目比对的结果，Sheet 名称为『数目差异』
'Sheet 4 放入F栏 金额比对的结果，Sheet 名称为『金额差异』
'档名2，放入动作(二)的比对结果
'档名3，放入动作(三)的比对结果
'tempsize = rowpos
For i = 1 To 3
Set newbook(i) = Workbooks.Add
newbook(i).Worksheets.Add
newbook(i).Worksheets(1).Name = "消失项次"
newbook(i).Worksheets(2).Name = "新增项次"
newbook(i).Worksheets(3).Name = "数目差异"
newbook(i).Worksheets(4).Name = "金额差异"
rowpos = 1
colpos = 1
For rowpos = 1 To 20
If temp(rowpos - 1, 0, i - 1) = "消失" Then
newbook(i).Worksheets(1).Cells(rowpos, colpos).Value = temp(rowpos -
1, 0, i - 1)
Else
If temp(rowpos - 1, 0, i - 1) = "新增" Then
newbook(i).Worksheets(2).Cells(rowpos, colpos).Value = temp(rowpos -
1, 0, i - 1)
End If
newbook(i).Worksheets(3).Cells(rowpos, colpos).Value = temp(rowpos - 1,
1, i - 1)
newbook(i).Worksheets(4).Cells(rowpos, colpos).Value = temp(rowpos - 1,
2, i - 1)
End If
Next
'存档
newbook(i).SaveAs Filename:=ThisWorkbook.Worksheets(i).Name
newbook(i).Close
Next
book_b.Close
End Sub
--
※ 发信站: 批踢踢实业坊(ptt.cc)
◆ From: 140.115.206.177