[VBA ] 比對資料填值的問題

看板Visual_Basic作者one164 (阿MON)時間13年前 (2012/02/10 18:53)推噓1(1推 0噓 7→)

留言8則, 2人參與討論串1/3 (看更多)

對不起，可能我表達的不是很清楚一開始sheet1就存在資料，以excel格式來說如下 A B C D E F G 1 one two three four five six 2 one 3 two 4 three 5 four 6 five 7 six 那假設今天有資料A內容是 one,two,three 資料B內容 three,four,five 經過比對在sheet7會出現three，那我加的動作是先把B1到G1放進data_c 把A2到A7放進data_d，再從sheet7抓資料，例子裡只有three，所以先從A欄找出three 再從第一列找出資料A的第一個"one"，找出來後在B4欄裡填入1這樣底下是一整天大大所寫的比對資料程式片斷我想要去增加一些功能但是修改完還是沒有動靜我也不知道哪裡出了問題，畢竟我不是專業出身 T_T 希望有大大能幫忙看一下這裡面總共有八個表 sheet1是我新增的一個表，目的是希望在比對資料後能找到相應的儲存格填入值 sheet2是操作的畫面 sheet3(資料A)用來跟sheet4(資料B)做比較經過比較可以得到sheet5,6,7,8 分別代表資料A缺少的(5)、資料B缺少的(6)、資料A和B共有的(7) sheet8和sheet5一樣就不多說了 PS. 前面有*的程式碼是我自己增加的 Private Sub cmdCompareab_Click() Dim n As Integer '判斷資料A的欄位數 Dim count_a, count_b, *count_row, *count_column As Double '資料A,B的筆數還有計算新資料表的列數與欄數 Dim temp As String Dim num As String 這邊因為在操作畫面有地方可以填入資料A的欄數(B1)還有資料A(b2)與資料B(b3)的筆數那如果使用者沒有填入，程式會自動去搜尋，所以才有以下程式碼，findx和findy是副程式用來找出列數和欄數 n = Sheet2.Range("B1") count_a = Sheet2.Range("b2") '資料A列數 count_b = Sheet2.Range("b3") '資料B列數 *count_c = findx(Sheet1) '新資料表列數 *count_d = findy(Sheet1) '新資料表欄數 If Sheet2.Range("B1") = "" Then n = findy(Sheet3) End If If Sheet2.Range("b2") = "" Then count_a = findx(Sheet3) End If If Sheet2.Range("b3") = "" Then count_b = findx(Sheet4) End If Call cleardata ReDim data_c(count_c) ReDim data_d(count_d) If count_a > count_b Then ReDim data_a(count_a) ReDim data_b(count_a) Else ReDim data_a(count_b) ReDim data_b(count_b) End If s = ChrB(160) ' 的ascii '這個我看不懂要做什麼用@@ 底下這兩個For迴圈是我自己寫的，從2開始的原因是新資料表的(1,1)是空白格 For i = 2 To count_c '將新資料列放入陣列 temp = "" For j = 1 To 1 temp = temp & Sheet1.Cells(i, j) '這邊用&的符號的意思我不明白 Next 因為作者本來有用就延用了 data_c(i) = temp Next For i = 1 To 1 '將新資料欄放入陣列 temp = "" For j = 2 To count_d temp = temp & Sheet1.Cells(i, j) Next data_d(i) = temp Next 底下兩個是原作者的For迴圈 '將資料A讀入陣列 For i = 1 To count_a temp = "" For j = 1 To temp = temp & Sheet3.Cells(i, j) Next data_a(i) = temp Next '將資料B讀入陣列 For i = 1 To count_b temp = "" For j = 1 To n temp = temp & Sheet4.Cells(i, j) Next data_b(i) = temp Next '開始比較A,B資料，有*號部份是我添加上去的我希望做到的部分是在比較出資料A和資料B相同的資料時，從新資料表的欄中(data_d)找出相同的，也從列中找出與data_a(1)相同的找出來後在新資料表的那格儲存格填入1，因為是第一次嘗試修改VB程式也不懂到底是哪個環節出問題，目前只做到這，再後面就都是原作者的程式碼 a = 0 b = 0 c = 0 *num = 1 For i = 1 To count_a For j = 1 To count_b If data_a(i) = data_b(j) Then '如果相等則列印出來 c = c + 1 For k = 1 To n temp = Sheet3.Cells(i, k) Sheet7.Cells(c, k) = temp *For L = 1 To count_d *If temp = data_d(L) Then *For m = 1 To count_c *If data_a(1) = data_c(m) Then *Sheet1.Cells(m,L).Value = num *End If *Next *End If *Next change_cell_format Sheet7.Cells(c, k), Sheet3.Cells(i, k) Next Exit For End If Next '後面可以省略不看 If j > count_b Then 'a的資料在b找不到 a = a + 1 For k = 1 To n temp = Sheet3.Cells(i, k) Sheet6.Cells(a, k) = temp Sheet8.Cells(a, k + n + 1) = temp change_cell_format Sheet6.Cells(a, k + n + 1), Sheet3.Cells(i, k) change_cell_format Sheet8.Cells(a, k + n + 1), Sheet3.Cells(i, k) '將不一樣的資料變成紅色 Sheet3.Cells(i, k).Font.Color = vbRed Next End If DoEvents Sheet2.Range("b4") = i / count_a Next For i = 1 To count_b For j = 1 To count_a If data_b(i) = data_a(j) Then '如果相等則離開 Exit For End If Next If j > count_a Then 'b的資料在a找不到 b = b + 1 For k = 1 To n temp = Sheet4.Cells(i, k) Sheet5.Cells(b, k) = temp Sheet8.Cells(b, k) = temp change_cell_format Sheet5.Cells(b, k), Sheet4.Cells(i, k) change_cell_format Sheet8.Cells(b, k), Sheet4.Cells(i, k) Sheet4.Cells(i, k).Font.Color = vbRed Next End If DoEvents Sheet2.Range("b5") = i / count_b Next End Sub -- ※ 發信站: 批踢踢實業坊(ptt.cc) ◆ From: 163.13.202.235