我在一个包含大量列的文件夹中有多个文件，让我们调用这些文件＆＃34; main.csv＆＃34;。 ＆＃34; main＆＃34;中有2列。其中包含X和Y坐标。在另一个名为＆＃34; site.csv＆＃34;的文件中，我有一个必需的 X和Y坐标及其网站＃的列表 我做了一个VBA：
1）留在＆＃34; main＆＃34;文件，只有符合＆＃34; B＆＃34;中的X和Y坐标的行。并且还会更新名为“网站”的列。在主文件中的＆＃34; site.csv＆＃34;文件（附上截图）
2）删除所有其余的
如果可能的话 （因为我不知道如何为此编码） - ＆GT;通过文件夹中的所有文件（例如＆＃34; main.csv＆＃34;）进行此VBA循环，因为它们有很多。参考文件是相同的 - ＆＃34; site.csv＆＃34;
截图：
Site.csv file - Reference file
到目前为止，我收到了以下错误：
运行时错误＆＃39; 1004＆＃39;：应用程序定义或对象定义的错误（位置为VBA注释）
以下是代码：
Option Explicit
Sub fetchdata()
Dim x As Integer
Dim y As Integer
Dim finalrow As Long
Dim i As Integer
Dim LastRow As Long
x = Application.Workbooks("Site.csv").Worksheets("Site").Range("A2").Value 'Stores the x-coordinate of the Site file which contains the list of required coordinates
y = Application.Workbooks("Site.csv").Worksheets("Site").Range("B2").Value
finalrow = Application.Workbooks("Main.csv").Worksheets("Main").Range("D70000").End(xlUp).Row 'Stores the row detail of the last row in the Main file
For i = 7 To finalrow
If Application.Workbooks("Main.csv").Worksheets("Main").Range(Cells(i, 4) = x And Cells(i, 5) = y) Then 'ERROR IDENTIFIED HERE
Application.Workbooks("Site.csv").Worksheets("Site").Range(Cells(i - 5, 3)).Copy
Application.Workbooks("Main.csv").Worksheets("Main").Range("F7").PasteSpecial xlPasteFormulasAndNumberFormats 'Here I basically want to replace the existing site number with that in my reference file (site.csv)
Else
Application.Workbooks("Main.csv").Worksheets("Main").Rows(i).EntireRow.Delete 'Delete Everything else
End If
Next i
End Sub
答案 0 :(得分：0)
我不相信Range类中的一个名为.ClearData的方法。你是说ClearContents吗？这将清除指定单元格中的所有值。
Sub fetchdata()
Dim x As Integer 'Coordinates that need to be fetched
Dim y As Integer
Dim finalrow As Integer
Dim i As Integer
ActiveSheet.Range("D2:D10000").ClearContents
x = Sheets("Sheet2").Range("A2").Value
y = Sheets("Sheet2").Range("B2").Value
finalrow = Sheets("Book1").Range("D10000").End(xlUp).Row
For i = 7 To finalrow
If Cells(i, 4) = x And Cells(i, 5) = y Then
Sheets("Book1").Range(Cells(i, 1), Cells(i, 221)).Copy
Sheets("Sheet2").Range("D10000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
End If
Next i
End Sub
答案 1 :(得分：0)
嗨，你的错误在以下几行：
.Range(Cells(i, 4) I removed Range()
= y) I removed ")"
Range(Cells(i - 5, 3)) I removed Range()
下面的代码应该可以使用
Option Explicit
Sub fetchdata()
Dim x As Integer
Dim y As Integer
Dim finalrow As Long
Dim i As Integer
Dim LastRow As Long
x = Application.Workbooks("Site.csv").Worksheets("Site").Range("A2").Value 'Stores the x-coordinate of the Site file which contains the list of required coordinates
y = Application.Workbooks("Site.csv").Worksheets("Site").Range("B2").Value
finalrow = Application.Workbooks("Main.csv").Worksheets("Main").Range("D70000").End(xlUp).Row 'Stores the row detail of the last row in the Main file
For i = 7 To finalrow
If Application.Workbooks("Main.csv").Worksheets("Main").Cells(i, 4) = x And Cells(i, 5) = y Then 'ERROR IDENTIFIED HERE
Application.Workbooks("Site.csv").Worksheets("Site").Cells(i - 5, 3).Copy
Application.Workbooks("Main.csv").Worksheets("Main").Range("F7").PasteSpecial xlPasteFormulasAndNumberFormats 'Here I basically want to replace the existing site number with that in my reference file (site.csv)
Else
Application.Workbooks("Main.csv").Worksheets("Main").Rows(i).EntireRow.Delete 'Delete Everything else
End If
Next i
End Sub
截至08/12的新代码，目录循环：
Sub fetchdata()
Dim x As Integer
Dim y As Integer
Dim finalrow As Long
Dim i As Integer
Dim site As Workbook
Dim main As Workbook
Dim site_sh As Worksheet
Dim main_sh As Worksheet
Dim LastRow As Long
Dim finalrow_main, finalrow_site, i_site, i_main, site_val_x, site_val_y, main_val_x, main_val_y As Variant
Dim criteria As String
Dim delete_row As Boolean
Dim MyObj As Object, MySource As Object, file As Variant
Dim file_path, list_file, final_message As String
file_path = "C:\Users\u6042371\Documents" 'Set directory for "Main" file types here
If Right(file_path, 1) <> "\" Then file_path = file_path & "\"
list_file = "" 'this will store a file list for later
criteria = "main*.xls" 'this will search for all files beginning with main ending with .xls, you can use * as a wildcard, just change main
file = Dir(file_path & criteria)
While (file <> "")
Workbooks.Open Filename:=file_path & file
Set main = Workbooks(file) 'will auto open
Set site = Workbooks("Site.xlsx") 'manual open this workbook
Set main_sh = main.Worksheets("Main") 'name of sheet ex Main sheet in Main workbook
Set site_sh = site.Worksheets("Site") 'name of sheet ex Site sheet in Site workbook
finalrow_main = main_sh.Range("D70000").End(xlUp).Row 'gets last row of Main Sheet
finalrow_site = site_sh.Range("A70000").End(xlUp).Row 'gets last row of Site Sheet
delete_row = False 'flag if to delete row at the end of for loop
For i_main = finalrow_main To 7 Step -1 'to loop through all Main x, y, this looks through end to start of data, delete technique
main_val_x = main_sh.Cells(i_main, 4).Value 'set x value of current row of Main sheet
main_val_y = main_sh.Cells(i_main, 5) 'set y value of current row of Main sheet
For i_site = 2 To finalrow_site 'to loop through all Site x,y starts at the beginning of site
site_val_x = site_sh.Cells(i_site, 1) 'set x value of current row of Site sheet
site_val_y = site_sh.Cells(i_site, 2) 'set y value of current row of Site sheet
If site_val_x = main_val_x And site_val_y = main_val_y Then 'compares x,y from Site to x,y from Main
main_sh.Cells(i_main, 6) = site_sh.Cells(i_site, 3)
delete_row = False 'Set delete to false because there has been a match
Exit For 'Exits loop to check next site row
Else
delete_row = True 'if there are no matches this will become True
End If
Next i_site
If delete_row = True Then 'if delete = True then delete
main_sh.Rows(i_main).Delete
End If
Next i_main
Workbooks(file).Save
Workbooks(file).Close
list_file = list_file + file + Chr(13)
file = Dir
Wend
final_message = "The following files have been processed:" + Chr(13) + list_file
MsgBox final_message
End Sub