vba - 使用范围单元格时出现错误 1004

Question

这个问题在这里已经有了答案:





Why does Range work, but not Cells?

(1 个回答)



Excel VBA, getting range from an inactive sheet

(3 个回答)


3个月前关闭。




这段代码我面临运行时错误 1004。这很奇怪，因为这段代码在另一个模块中工作，但是当我把它放在用户表单中时，它不起作用。

我发现使用断点时出现在这一行的问题

Set SourceRange = WorkBk.Worksheets(1).Range(Cells(FindRow + 2, FindCol), Cells(LastRow, FindCol)) 

我已经研究并尝试了一切，例如

Set SourceRange = WorkBk.Worksheets(1).Range(Cells(FindRow + 2, FindCol)).Resize(LastRow)

Set SourceRange = WorkBk.Worksheets(1).Range(Cells(FindRow + 2, FindCol)).Resize(LastRow, LastCol) 
With WorkBk.Worksheets(1) 
.Range(.Cells(FindRow + 2, FindCol), .Cells(FindRow + 2, FindCol)) 
End With

似乎没有一个工作。这段代码再次在另一个模块上工作过。我不知道为什么当我在用户表单的命令按钮 sub 下输入时它不起作用。

请帮忙

完整代码:

Dim FileName As String 
Dim SummarySheet As Worksheet 
Dim WorkBk As Workbook 
Dim FolderPath As String 
Dim LastRow As Long 
Dim LastCol As Long 
Dim NRow As Long 
Dim NCol As Long 
Dim SourceRange As Range 
Dim DestRange As Range 


' Create a new workbook and set a variable to the first sheet.
Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1) 

' Set Worksheet Name
ActiveSheet.Name = "BTS1 DL_HARQ" 

' Call Dir the first time, pointing it to all Excel files in the folder path.
FileName = Dir(FolderPath & "*BTS1_PHYMAC(DL_HARQ).csv*") 

' Initialize column to 1
NCol = 1 


' Loop until Dir returns an empty string.
Do While FileName <> "" 

' NRow keeps track of where to insert new rows in the destination workbook.
NRow = 1 

' Open a workbook in the folder
Set WorkBk = Workbooks.Open(FolderPath & FileName) 

' Set the cell in row 1 to be the file name.
SummarySheet.Cells(1, NCol) = FileName 

'Find the last row to be copied
LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row 

'Find the last row to be copied
LastCol = ActiveSheet.Cells(13, Columns.Count).End(xlToLeft).Column 

' Set the source range to be K14 to last row
' Modify this range for your workbooks.
' It can span multiple rows.
' Set SourceRange = WorkBk.Worksheets(1).Range("K14:K" & Lastrow)

Dim rFind As Range 
Dim ColCount As Long 
Dim FindRow As Long 
Dim FindCol As Long 

For ColCount = 1 To LastCol 
With Range(Cells(1, ColCount), Cells(LastRow, ColCount)) 
Set rFind = .Find(What:="Tx Throughput [kbps]", LookIn:=xlValues, LookAt:=xlWhole) 
If Not rFind Is Nothing Then 
FindRow = rFind.Row 
FindCol = rFind.Column 
End If 
End With 
Next ColCount 

Set SourceRange = WorkBk.Worksheets(1).Range(Cells(FindRow + 2, FindCol), Cells(LastRow, FindCol)) 

' Set the destination range to start at row 2 and
' be the same size as the source range.
Set DestRange = SummarySheet.Cells(NRow + 1, NCol) 
Set DestRange = DestRange.Resize(SourceRange.Rows.Count, _ 
SourceRange.Columns.Count) 

' Copy over the values from the source to the destination.
DestRange.Value = SourceRange.Value 

' Increase NRow so that we know where to copy data next.
NRow = NRow + DestRange.Rows.Count 

' Close the source workbook without saving changes.
WorkBk.Close savechanges:=False 

' Use Dir to get the next file name.
FileName = Dir() 

' Increase NCol to copy the next file on the next column
NCol = NCol + 1 
Loop 

End Sub

Answer 1

我相信您在使用 Cells 时需要引用您的工作表:

Set SourceRange = WorkBk.Worksheets(1).Range(WorkBk.Worksheets(1).Cells(FindRow + 2, FindCol), WorkBk.Worksheets(1).Cells(LastRow, FindCol))  

如果您为此工作表创建一个变量，这将有很大帮助，这将使其更易于阅读和修改。