[VBA ] 比對資料填值的問題
對不起,可能我表達的不是很清楚
一開始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
推
02/11 09:12, , 1F
02/11 09:12, 1F
→
02/11 09:26, , 2F
02/11 09:26, 2F
→
02/11 09:27, , 3F
02/11 09:27, 3F
→
02/11 09:28, , 4F
02/11 09:28, 4F
→
02/11 09:30, , 5F
02/11 09:30, 5F
→
02/11 15:44, , 6F
02/11 15:44, 6F
→
02/11 15:45, , 7F
02/11 15:45, 7F
→
02/11 15:46, , 8F
02/11 15:46, 8F
※ 編輯: one164 來自: 163.13.202.235 (02/13 14:09)
討論串 (同標題文章)
Visual_Basic 近期熱門文章
PTT數位生活區 即時熱門文章