VBA-根据多个条件从另一张纸复制单元格 [英] VBA - copy cells from another sheet based on multiple criteria
问题描述
我是VBA的新手,但情况确实很糟糕.我有两个工作表.我必须根据每个客户的地址向每个客户分配一个销售人员.在Sheet1上,我使用三个数据列,邮政编码(K),城市(I)和国家(L).在Sheet2上,我在B列和C列(低值和高值),城市(D)和国家(E)中有一个邮政编码范围.每行都有分配的销售人员的姓名.
I'am new to VBA and got stuck real bad. I have two worksheets. I have to assign a sales person to every customer based on their address. On Sheet1 I use three data columns, Zip (K), City (I) and Country (L). On Sheet2 I have a Zip code range in column B and C (low and high value), the City (D) and the Country (E). In every row there is the name of the assigned sales person.
代码要求:检查客户所在的国家/地区是否与第一个销售人员所在的国家/地区匹配.如果是,请检查客户的邮政编码是否在范围内.如果匹配,将销售人员姓名复制到Sheet1,然后移至下一行.如果在Sheet2上没有给出作为标准的邮政编码范围,或者在客户的邮政编码上没有匹配项,请检查City是否匹配,是否有匹配的销售人员姓名复制到Sheet1,然后移至下一行.如果在Sheet2上没有给出任何城市作为标准,或者在客户的城市上没有匹配项,请检查国家/地区是否匹配,然后将销售人员姓名复制到Sheet1.
The requirements for the code: Check if customer's country matches with the first sales persons country. If yes check if customer's zip code is in range. If there is a match copy sales person name to Sheet1 and move to next row. If no Zip range is given on Sheet2 as criteria or there is no match on customer's zip, check if City matches, if there is a match copy sales person name to Sheet1 and move to next row. If no city is given on Sheet2 as criteria or there is no match on customer's city,check if country matches and copy sales persons name to 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`
推荐答案
尝试以下代码,让我知道它是否有效或需要更改
Try the below code and let me know if it works or changes required
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
这篇关于VBA-根据多个条件从另一张纸复制单元格的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!