對不起，可能我表達的不是很清楚 一開始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 ※ 編輯: one164 來自: 163.13.202.235 (02/13 14:09)