2017-08-02 231 views
1

編輯:感謝您的幫助之前,我已經在代碼中的變化和編輯我的問題(包括如A &乙一定的參考),使得它更容易,現在理解了。數據提取

我有很多列的文件夾中的多個文件,讓我們稱之爲一個這些文件「main.csv」。 「main」中有2列包含X和Y座標。在所謂的「site.csv」另一個文件,我有的列表中選擇所需 X和Y座標及其網站# 我做了一個VBA來:

1)保持在「主」的文件,只有與「B」中的X和Y座標相匹配的行,並且還在主文件中用「site.csv」文件(附帶屏幕截圖)中的名稱更新了一個名爲「Site」的列。

2)刪除所有其餘

並且如果可能的話(因爲我d ONT懂得這個代碼) - >文件夾中進行此VBA環通的所有文件(如「main.csv」),因爲有他們的很多。參考文件是相同的 - 「site.csv」

截圖:

Main.csv file

Site.csv file - Reference file

到目前爲止,我發現了以下錯誤:

運行時錯誤「1004」:應用程序定義或對象定義的錯誤(如位置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

所有符合條件的對象,以他們的父母。你沒有在代碼中指定你想要使用哪個'workbook'。另外'Cells(i,4)'應該限定在工作表中(工作表指向工作簿)。 –

+0

當使用不同的紙張工作,並專門工作簿的最佳實踐,並要求您是明確你的目標。嘗試先修復它們。實例爲工作簿( 「B」)。工作表( 「B」)。範圍( 「A7」)或工作簿( 「A」)。WorkSheets(「A」) – fcsr

+0

@ScottHoltzman進行了更改,請查看 – out1121

回答

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 
+0

它沒有錯誤地運行,但沒有任何反映在文件上的變化。他們似乎是一樣的。 – out1121

+0

Application.Workbooks(「Main.csv」)。Worksheets(「Main」)。Range(「F7」)這行不是動態的,代碼將每次粘貼到這個單元格上 – fcsr

+0

我只試圖回答你現有的關於錯誤,而且我沒有真正瞭解代碼 – fcsr

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