Visual_Basic 板


LINE

問題幾乎都解決了 只剩下資料大小判定 之前的問題 原來是我變數打錯啦xd 忘記vb 怎麼限定變數一定要定義才能用了 Sub Macro1() '比對程式需求有: 'Excel 分成 A、B 兩個檔,每個檔案內有1、2、3 三個 Sheet。 '所以一共有六組 → A1、A2、A3、B1、B2、B3。 '動作(一) 比對A1 vs. B1的內容 '動作 '(二) 比對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 'A欄 → 項次比對:A1 Yes; B1No 為『消失』。 'A欄 → 項次比對:A1 No; B1Yes 為『新增』。 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 colpos = 5 'E欄 → 數目比對:A1、B1皆為 Yes,但 E欄有變動。 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 colpos = 6 'F欄 → 金額比對:A1、B1皆為 Yes,但 F 欄有變動。 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 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
1F:推 fumizuki:option explicit 03/21 19:41
2F:→ fri13:謝謝~~ 03/21 21:01







like.gif 您可能會有興趣的文章
icon.png[問題/行為] 貓晚上進房間會不會有憋尿問題
icon.pngRe: [閒聊] 選了錯誤的女孩成為魔法少女 XDDDDDDDDDD
icon.png[正妹] 瑞典 一張
icon.png[心得] EMS高領長版毛衣.墨小樓MC1002
icon.png[分享] 丹龍隔熱紙GE55+33+22
icon.png[問題] 清洗洗衣機
icon.png[尋物] 窗台下的空間
icon.png[閒聊] 双極の女神1 木魔爵
icon.png[售車] 新竹 1997 march 1297cc 白色 四門
icon.png[討論] 能從照片感受到攝影者心情嗎
icon.png[狂賀] 賀賀賀賀 賀!島村卯月!總選舉NO.1
icon.png[難過] 羨慕白皮膚的女生
icon.png閱讀文章
icon.png[黑特]
icon.png[問題] SBK S1安裝於安全帽位置
icon.png[分享] 舊woo100絕版開箱!!
icon.pngRe: [無言] 關於小包衛生紙
icon.png[開箱] E5-2683V3 RX480Strix 快睿C1 簡單測試
icon.png[心得] 蒼の海賊龍 地獄 執行者16PT
icon.png[售車] 1999年Virage iO 1.8EXi
icon.png[心得] 挑戰33 LV10 獅子座pt solo
icon.png[閒聊] 手把手教你不被桶之新手主購教學
icon.png[分享] Civic Type R 量產版官方照無預警流出
icon.png[售車] Golf 4 2.0 銀色 自排
icon.png[出售] Graco提籃汽座(有底座)2000元誠可議
icon.png[問題] 請問補牙材質掉了還能再補嗎?(台中半年內
icon.png[問題] 44th 單曲 生寫竟然都給重複的啊啊!
icon.png[心得] 華南紅卡/icash 核卡
icon.png[問題] 拔牙矯正這樣正常嗎
icon.png[贈送] 老莫高業 初業 102年版
icon.png[情報] 三大行動支付 本季掀戰火
icon.png[寶寶] 博客來Amos水蠟筆5/1特價五折
icon.pngRe: [心得] 新鮮人一些面試分享
icon.png[心得] 蒼の海賊龍 地獄 麒麟25PT
icon.pngRe: [閒聊] (君の名は。雷慎入) 君名二創漫畫翻譯
icon.pngRe: [閒聊] OGN中場影片:失蹤人口局 (英文字幕)
icon.png[問題] 台灣大哥大4G訊號差
icon.png[出售] [全國]全新千尋侘草LED燈, 水草

請輸入看板名稱,例如:WOW站內搜尋

TOP