簡體   English   中英

VBA使用文件對話框進行搜索,然后復制並粘貼

[英]VBA use filedialog to search, then copy and paste

現在,我的代碼將復制並粘貼所有數據,而沒有任何特定的選擇條件。 我正在嘗試根據文件的名稱將某些文件中的特定信息復制並粘貼到活動工作表中。 我相信我需要一些功能可以幫助我解決這個問題。 任何幫助都會很棒。 謝謝。

Private Sub CommandButton1_Click()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set fd = Application.FileDialog(msoFileDialogFilePicker)
Set wbb = ThisWorkbook
Set sh = wbb.Worksheets("Sheet1")

With fd
    .Title = "Please select Job Folder"
    .AllowMultiSelect = True
    Err.Clear
    FileChosen = fd.Show
    If MsgBox("Files selected, continue?", vbYesNo) = vbNo Then Exit Sub

    For i = 1 To fd.SelectedItems.Count
        file = fd.SelectedItems(i)
        Workbooks.Open Filename:=file, ReadOnly:=True
        If file = "" Then Exit Sub
        filesheet = "Sheet1"
        ActiveWorkbook.Sheets(filesheet).Range("A1:A3").Copy
        LastRow = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row
        sh.Cells(sh.Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        ActiveWorkbook.Close savechanges:=False
    Next i
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

偽碼

但是您已經在已發布的表格上找到了答案!

要檢查另一個字符串中的一個字符串,請使用InStr()函數:

If InStr(CStr(file), "PartOfFileName") <> 0 Then
  'file found, copy specific parts to that file
End If

這里有一些關於如何使用該功能的更好的例子。

建議對所有變量進行“模糊處理”,以更好地控制代碼。

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM