***编辑以下问题。我一直在玩它,问题出在我的数组resultArray(i)中。当我使用resultArray(i) = Sheets("DeSL_CP").Range("P" & j).Value
代替行.Range("M" & i).Value = Sheets("DeSL_CP").Range("P" & j).Value
时,它可以工作,但是需要更长的时间。谁能确定为什么我的resultArray(i)返回全零?
***原始帖子: 我是数组新手,所以我可能犯了一个愚蠢的错误。我有两张纸:摘要在col A中有一个productid,在AK中将该产品标记为未许可或许可的字段。 DeSL_CP对于每个productId(在B列中)有多行。我需要找到未授权产品的活动代码(Col K)AA0001的行,并返回基线结束日期(col P)。然后,我需要找到其余产品的代码A0003,并返回基线的结尾行。基线N应该在摘要表的M行中。
我的代码没有抛出错误。它只是用1/0/1900填充所有M列。救命!
Sheets("Summary").Select
Dim lastRow As Long, lastRow1 As Long
lastRow = Range("A" & Rows.Count).End(xlUp).Row
lastRow1 = Sheets("DeSL_CP").Range("A" & Rows.Count).End(xlUp).Row
lastRow1 = lastRow1 - 1
Dim BaselineEnd As Variant, ActivityCode As Variant, ProductIDDeSL As Variant, Licensed As Variant, ProductIDSumm As Variant
BaselineEnd = ThisWorkbook.Worksheets("DeSL_CP").Range("P2:P" & lastRow1).Value
ActivityCode = ThisWorkbook.Worksheets("DeSL_CP").Range("K2:K" & lastRow1).Value
ProductIDDeSL = ThisWorkbook.Worksheets("DeSL_CP").Range("B2:B" & lastRow1).Value
Licensed = ThisWorkbook.Worksheets("Summary").Range("AK7:AK" & lastRow).Value
ProductIDSumm = ThisWorkbook.Worksheets("Summary").Range("A7:A" & lastRow).Value
Dim resultArray() As Date
ReDim resultArray(7 To lastRow)
Dim i As Long, j As Long
With ThisWorkbook.Worksheets("Summary")
For i = 7 To UBound(ProductIDSumm)
For j = 2 To UBound(ProductIDDeSL)
If ProductIDSumm(i, 1) = ProductIDDeSL(j, 1) Then
If Licensed(i, 1) = "Unlicensed" Then
If ActivityCode(j, 1) = "AA0001" Then
resultArray(i) = Sheets("DeSL_CP").Range("P" & j).Value
Exit For
End If
Else
If ActivityCode(j, 1) = "A0003" Then
resultArray(i) = Sheets("DeSL_CP").Range("P" & j).Value
Exit For
End If
End If
End If
Next j
Next i
.Range("M7").Resize(lastRow - 7 + 1, 1).Value = resultArray
End With
有时候是空白,但很多时候不是。我隐藏了很多数据,将重点放在重要的列上,这在一个世纪的月份中-有关系吗?
答案 0 :(得分:1)
在代码中发现了一些类似lastRow1 = Sheets("DeSL_CP").Range("A" & Rows.Count).End(xlUp).Row
的问题,这些问题更喜欢基于ColB。也认为For
循环的起始值应该是1而不是7和2(取决于Option Base)。 ResultArray可以直接从BaselineEnd(j, 1)
填充。最后,ResultArray用Range("M7").Resize(UBound(resultArray), 1).Value = resultArray
解决了。合并后的最终代码:
Option Base 1
Sub test()
Sheets("Summary").Select
Dim lastRow As Long, lastRow1 As Long
lastRow = Sheets("Summary").Range("A" & Rows.Count).End(xlUp).Row
lastRow1 = Sheets("DeSL_CP").Range("B" & Rows.Count).End(xlUp).Row
lastRow1 = lastRow1 - 1
Dim BaselineEnd As Variant, ActivityCode As Variant, ProductIDDeSL As Variant, Licensed As Variant, ProductIDSumm As Variant
BaselineEnd = ThisWorkbook.Worksheets("DeSL_CP").Range("P2:P" & lastRow1).Value
ActivityCode = ThisWorkbook.Worksheets("DeSL_CP").Range("K2:K" & lastRow1).Value
ProductIDDeSL = ThisWorkbook.Worksheets("DeSL_CP").Range("B2:B" & lastRow1).Value
Licensed = ThisWorkbook.Worksheets("Summary").Range("AK7:AK" & lastRow).Value
ProductIDSumm = ThisWorkbook.Worksheets("Summary").Range("A7:A" & lastRow).Value
Dim resultArray() As Date
ReDim resultArray(lastRow - 7 + 1, 1)
Dim i As Long, j As Long
With ThisWorkbook.Worksheets("Summary")
For i = 1 To UBound(ProductIDSumm)
For j = 1 To UBound(ProductIDDeSL)
'If Not Sheets("DeSL_CP").Rows(j).Hidden Then
If ProductIDSumm(i, 1) = ProductIDDeSL(j, 1) Then
If Licensed(i, 1) = "Unlicensed" Then
If ActivityCode(j, 1) = "AA0001" Then
resultArray(i, 1) = BaselineEnd(j, 1)
Exit For
End If
Else
If ActivityCode(j, 1) = "A0003" Then
resultArray(i, 1) = BaselineEnd(j, 1)
Exit For
End If
End If
End If
'End If
Next j
Next i
Range("M7").Resize(UBound(resultArray), 1).Value = resultArray
End With
End Sub
我简单地尝试了所有数组,发现工作正常
Sub test2()
Sheets("Summary").Select
Dim lastRow As Long, lastRow1 As Long
Dim i, j As Long, Found As Boolean
lastRow = Range("A" & Rows.Count).End(xlUp).Row
lastRow1 = Sheets("DeSL_CP").Range("B" & Rows.Count).End(xlUp).Row
lastRow1 = lastRow1
Dim BaselineEnd As Variant, ActivityCode As Variant, ProductIDDeSL As Variant, Licensed As Variant, ProductIDSumm As Variant
For i = 7 To lastRow
Found = False
ProductIDSumm = ThisWorkbook.Worksheets("Summary").Cells(i, 1).Value
Licensed = ThisWorkbook.Worksheets("Summary").Cells(i, 37).Value
If ProductIDSumm <> "" Then
For j = 2 To lastRow1
ProductIDDeSL = ThisWorkbook.Worksheets("DeSL_CP").Cells(j, 2).Value 'Col B
ActivityCode = ThisWorkbook.Worksheets("DeSL_CP").Cells(j, 11).Value 'Col K
BaselineEnd = ThisWorkbook.Worksheets("DeSL_CP").Cells(j, 16).Value ' Col P
If ProductIDDeSL <> "" Then ' to skip blank rows
If ProductIDSumm = ProductIDDeSL Then
If Licensed = "Unlicensed" Then
If ActivityCode = "AA0001" Then
Found = True
Exit For
End If
Else
If ActivityCode = "A0003" Then
Found = True
Exit For
End If
End If
End If
End If
Next j
ThisWorkbook.Worksheets("Summary").Cells(i, 13).Value = IIf(Found, BaselineEnd, "Not Found")
End If
Next i
编辑:由于您应该拥有大数据并有处理时间问题。只是出于好奇,我添加了find方法解决方案作为第三种选择
Sub test3()
Sheets("Summary").Select
Dim lastRow As Long, lastRow1 As Long
Dim i, j As Long, Found As Boolean
lastRow = Sheets("Summary").Range("A" & Rows.Count).End(xlUp).Row
lastRow1 = Sheets("DeSL_CP").Range("B" & Rows.Count).End(xlUp).Row
lastRow1 = lastRow1
Dim RngIDsm, RngIDde, Cl, Cl2 As Range
Set RngIDsm = Sheets("Summary").Range("A7:A" & lastRow)
Set RngIDde = Sheets("DeSL_CP").Range("B2:B" & lastRow1)
Dim BaselineEnd As Variant, ActivityCode As Variant, ProductIDDeSL As Variant, Licensed As Variant, ProductIDSumm As Variant
For Each Cl In RngIDsm
Found = False
ProductIDSumm = Cl.Value
Licensed = Cl.Offset(, 36).Value
With RngIDde
Set Cl2 = .Find(ProductIDSumm, LookIn:=xlValues)
If Not Cl2 Is Nothing Then
firstAddress = Cl2.Address
Do
ActivityCode = Cl2.Offset(, 9).Value 'Col K
If Licensed = "Unlicensed" Then
If ActivityCode = "AA0001" Then
BaselineEnd = Cl2.Offset(, 14).Value
Found = True
Exit Do
End If
Else
If ActivityCode = "A0003" Then
BaselineEnd = Cl2.Offset(, 14).Value
Found = True
Exit Do
End If
End If
Set Cl2 = .FindNext(Cl2)
Loop While Not Cl2 Is Nothing And Cl2.Address <> firstAddress
End If
End With
Cl.Offset(, 12).Value = IIf(Found, BaselineEnd, "Not Found")
Next Cl
End Sub
答案 1 :(得分:1)
很高兴听到你让它起作用...
关于您的原始问题,您需要WorksheetFunction.Transpose(resultArray)
才能粘贴到垂直列
不确定这样做是否会更快