[英]VBA - copy cells from another sheet based on multiple criteria
我是VBA的新手,感覺很糟糕。 我有兩個工作表。 我必須根據每個客戶的地址向每個客戶分配一個銷售人員。 在Sheet1上,我使用三個數據列,郵政編碼(K),城市(I)和國家(L)。 在Sheet2上,我在B列和C列(低和高值),城市(D)和國家(E)中有一個郵政編碼范圍。 每行中都有分配的銷售人員的姓名。
代碼要求:檢查客戶所在的國家/地區是否與第一個銷售人員所在的國家/地區匹配。 如果是,請檢查客戶的郵政編碼是否在范圍內。 如果匹配,將銷售人員姓名復制到Sheet1,然后移至下一行。 如果在Sheet2上沒有給出作為標准的郵政編碼范圍,或者在客戶的郵政編碼上沒有匹配項,請檢查City是否匹配,是否有匹配的銷售人員姓名復制到Sheet1,然后移至下一行。 如果在Sheet2上沒有給出任何城市作為標准,或者在客戶的城市上沒有匹配項,請檢查國家/地區是否匹配,然后將銷售人員姓名復制到Sheet1。
到目前為止,這是怎么回事:
`Sub Territory()
Dim i As Integer
Dim sh1 As Worksheet, sh2 As Worksheet
Dim sh1Rws As Long, sh1Rng As Range, s1 As Range
Dim sh2lowRws As Long, sh2lowRng As Range, s2l As Range
Dim sh2highRws As Long, sh2highRng As Range, s2h As Range
Set sh1 = Sheets("Sheet1")
Set sh2 = Sheets("Sheet2")
Set i = 1
With sh1
sh1Rws = .Cells(Rows.Count, "K").End(xlUp).Row
Set sh1Rng = .Range(.Cells(1, "K"), .Cells(sh1Rws, "K"))
End With
With sh2l
sh2lowRws = .Cells(Rows.Count, "B").End(xlUp).Row
Set sh2lowRng = .Range(.Cells(1, "B"), .Cells(sh2lowRws, "B"))
End With
With sh2h
sh2highRws = .Cells(Rows.Count, "C").End(xlUp).Row
Set sh2highRng = .Range(.Cells(1, "C"), .Cells(sh2highRws, "C"))
End With
For Each s1 In sh1Rng
For Each s2l In sh2lowRng
If s1 > s2l And s1 < s2h Then sh2lowRws.Copy Destination:=Sheet.sh1.Range("u", i)
End If
Set i = i + 1
End Sub`
嘗試以下代碼,讓我知道它是否有效或需要更改
Sub test()
i = Sheets(1).Range("a1048576").End(xlUp).Row
l = Sheets(2).Range("a1048576").End(xlUp).Row
For k = 2 To i
For x = 2 To l
CityCus = Sheets(1).Range("I" & k).Value
CitySales = Sheets(2).Range("D" & x).Value
CotyCus = Sheets(1).Range("L" & k).Value
CotySales = Sheets(2).Range("E" & x).Value
ZipCus = Sheets(1).Range("K" & k).Value
ZipUpperSales = Sheets(2).Range("B" & x).Value
ZiplowerSales = Sheets(2).Range("C" & x).Value
c = Sheets(1).Range("b" & k).Value
d = Sheets(2).Range("A" & x).Value
If CotyCus = CotySales Then
If CityCus = CitySales Then
If ZipCus <= ZiplowerSales And ZipCus >= ZipUpperSales Then
Sheets(1).Range("b" & k).Value = Sheets(2).Range("A" & x).Value
End If
End If
End If
Next
Next
End Sub
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.