hoabattu3387
Thành viên chính thức
- Tham gia
- 11/9/08
- Bài viết
- 91
- Được thích
- 2
Hi các anh/chị diễn đàn
em có một file gồm 3 sheets dữ liệu. mục đích là đối chiếu các trường thông tin theo dòng của sheet1 và sheet2 với nhau (từ cột A đến cột H, bỏ qua cột G). nếu dữ liệu nào có ở sheet2 mà ko có ở sheet1 hoặc dữ liệu có ở sheet1 mà không có ở sheet2 thì kết quả gửi sheet3. dữ liệu nào có cả 2 sheet1 và sheet2 thì sum tổng tiền cột C ạ.
Em có viết một đoạn code so sánh một chiều giữa sheet2 và sheet1, nhưng code dài quá, e thấy loằng ngoằng và ko tối ưu, nên chưa viết chiều so sánh giữa sheet1 và sheet2. nhờ các anh/chị giúp e cải thiện nhé!
Sub Oval1_Click()
Dim dic, dic1 As Object, arr1(), arr2(), wrong(), notwrong(), i, j As Integer
Set dic = CreateObject("Scripting.Dictionary")
With Sheet1
arr1 = .Range(.[a1], .[h65536].End(xlUp)).Value
For i = 1 To UBound(arr1, 1)
orgin = Val(.Range("B" & i).Value) & Val(.Range("C" & i).Value) & .Range("e" & i).Value & Val(.Range("h" & i).Value)
If Not dic.exists(orgin) Then
dic.Add orgin, i
End If
Next
End With
With Sheet2
arr2 = .Range(.[a1], .[j65536].End(xlUp)).Value
ReDim wrong(1 To UBound(arr2, 1), 1 To 10)
ReDim notwrong(1 To UBound(arr2, 1), 1 To 10)
k = 1
H = 1
For j = 1 To UBound(arr2, 1)
ORGIN1 = Val(.Range("B" & j).Value) & Val(.Range("C" & j).Value) & .Range("e" & j).Value & .Range("h" & j).Value
If Not dic.exists(ORGIN1) Then
dic.Add ORGIN1, j
For t = 1 To 10
wrong(k, t) = arr2(j, t)
Next
k = k + 1
Else
For m = 1 To 10
notwrong(H, m) = arr2(j, m)
Next
tong = tong + notwrong(H, 3)
H = H + 1
End If
Next
End With
MsgBox (tong)
With Sheet3
.[a1].Resize(k, 10) = wrong
End With
End Sub
em có một file gồm 3 sheets dữ liệu. mục đích là đối chiếu các trường thông tin theo dòng của sheet1 và sheet2 với nhau (từ cột A đến cột H, bỏ qua cột G). nếu dữ liệu nào có ở sheet2 mà ko có ở sheet1 hoặc dữ liệu có ở sheet1 mà không có ở sheet2 thì kết quả gửi sheet3. dữ liệu nào có cả 2 sheet1 và sheet2 thì sum tổng tiền cột C ạ.
Em có viết một đoạn code so sánh một chiều giữa sheet2 và sheet1, nhưng code dài quá, e thấy loằng ngoằng và ko tối ưu, nên chưa viết chiều so sánh giữa sheet1 và sheet2. nhờ các anh/chị giúp e cải thiện nhé!
Sub Oval1_Click()
Dim dic, dic1 As Object, arr1(), arr2(), wrong(), notwrong(), i, j As Integer
Set dic = CreateObject("Scripting.Dictionary")
With Sheet1
arr1 = .Range(.[a1], .[h65536].End(xlUp)).Value
For i = 1 To UBound(arr1, 1)
orgin = Val(.Range("B" & i).Value) & Val(.Range("C" & i).Value) & .Range("e" & i).Value & Val(.Range("h" & i).Value)
If Not dic.exists(orgin) Then
dic.Add orgin, i
End If
Next
End With
With Sheet2
arr2 = .Range(.[a1], .[j65536].End(xlUp)).Value
ReDim wrong(1 To UBound(arr2, 1), 1 To 10)
ReDim notwrong(1 To UBound(arr2, 1), 1 To 10)
k = 1
H = 1
For j = 1 To UBound(arr2, 1)
ORGIN1 = Val(.Range("B" & j).Value) & Val(.Range("C" & j).Value) & .Range("e" & j).Value & .Range("h" & j).Value
If Not dic.exists(ORGIN1) Then
dic.Add ORGIN1, j
For t = 1 To 10
wrong(k, t) = arr2(j, t)
Next
k = k + 1
Else
For m = 1 To 10
notwrong(H, m) = arr2(j, m)
Next
tong = tong + notwrong(H, 3)
H = H + 1
End If
Next
End With
MsgBox (tong)
With Sheet3
.[a1].Resize(k, 10) = wrong
End With
End Sub
