Re: [VBA ] 小弟我想不出來怎麼寫了
小弟我目前寫成這樣了
但是還怪怪的
還剩一個主要的問題還沒解
資料大小的判斷
不知道哪位前輩可以幫忙給點意見的
多謝
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
討論串 (同標題文章)
完整討論串 (本文為第 2 之 3 篇)：
Visual_Basic 近期熱門文章
PTT數位生活區 即時熱門文章
