选择具有语句(组合文件)VBA的某些文件

时间:2015-03-12 12:48:57

标签: vba

我有一个代码将两个excel文件合并到一个文件中。 没有保存。

我先用dialogWindow选择SourceFolder, 然后用另一个dialogWindow选择一个TargetFolder。

我想要而不是让两个dialogwindows使用One来遍历整个文件夹。

文件夹中的文件名具有以下模式: 但名字几乎可以是任何东西,有一件事可以使它们成为一对。

请关注文件名,以便查看模式:

TEST_Translation2_jeeves_sv.xls
TEST_Translation2_jeeves_sv_NoTrans.xls

TEST_Translation2_UCHPResourcesCommon_de.xls
TEST_Translation2_UCHPResourcesCommon_de_NoTrans.xls

TEST_Translation2_creditDocument_ar.xls
TEST_Translation2_creditDocument_ar_NoTrans.xls

如果选择示例的第一个文件:

我现在想要将“TEST_Translation2_jeeves_sv_NoTrans.xls”中的工作表合并到“TEST_Translation2_jeeves_sv.xls”并保存文件(TEST_Translation2_jeeves_sv.xls)

脚本需要遍历整个文件夹。

有人可以帮我修改我的代码吗?

Sub Combinles_Step1()    
'Declare Variables
Dim WorkbookDestination As Workbook
Dim WorkbookSource As Workbook
Dim WorksheetSource As Worksheet
Dim FolderLocation As String
Dim strFilename As String


With Application.FileDialog(msoFileDialogFolderPicker)

    .AllowMultiSelect = False
    .Title = "Select Source folder"
    If .Show = -1 Then

        Application.DisplayAlerts = False
        Application.EnableEvents = False
        Application.ScreenUpdating = False

        FolderLocation = .SelectedItems(1)

        'Dialog box to determine which files to use. Use ctrl+a to select all files in folder.
        SelectedFiles = Application.GetOpenFilename( _
            filefilter:="Excel Files (*.xls*), *.xls*", MultiSelect:=True)

        'Create a new workbook
        Set WorkbookDestination = Workbooks.Add(xlWBATWorksheet)
        strFilename = Dir(FolderLocation & "\*.xls", vbNormal)

        'Iterate for each file in folder
        If Len(strFilename) = 0 Then Exit Sub


        Do Until strFilename = ""

                Set WorkbookSource = Workbooks.Open(Filename:=FolderLocation & "\" & strFilename)
                Set WorksheetSource = WorkbookSource.Worksheets(1)
                WorksheetSource.Copy After:=WorkbookDestination.Worksheets(WorkbookDestination.Worksheets.Count)
                WorkbookSource.Close False
            strFilename = Dir()

        Loop
        WorkbookDestination.Worksheets(1).Delete

        Application.DisplayAlerts = True
        Application.EnableEvents = True
        Application.ScreenUpdating = True
    End If
End With
End Sub

提前谢谢

1 个答案:

答案 0 :(得分:1)

好的,没有进入代码细节:

Get the name of the file
Check to see if it contains the value "_NoTrans"
   If yes ignore it and move to the next
   Else the file name does not have the value "_NoTrans" then
      Take that name store it in a string variable
      Insert the "_NoTrans" value in front of the ".xls"
          Basically take the string value chop off the ".xls"
          Concatenate new string value + "_NoTrans" + ".xls"
              Note I do it in 3 pieces because "_NoTrans" should be a constant
              and ".xls" should also be a constant
Take the new filename variable and check if it exists
   If yes open it and work with it
   Else error

希望能让你朝着正确的方向前进

好的不理解 - 这不会解决问题吗? - 我的意思是你所要做的就是将VBA特定的语法应用到上面。

You are already getting the name of the file from what it looks like 
so it did not seem like you needed that explained.  

The next line is just a string compare function which you can find here
http://www.homeandlearn.org/text_and_excel_vba.html

The next 2 lines are simply an If / Else statement based on the results
of the string compare.

The next line pretty straight forward as well an assignment statement

The next 5 lines are just explaining a bit of simple string manipulations
InStr / Left / Dim y As String = "firstpart" + "middlepart" + "lastpart"
The above link will explain these if you do not understand them

The last 3 lines are just using the new name check to see if the file is
there which if you can open a file you should know how to check if a
file exists - yes/no?  if not go here
http://stackoverflow.com/questions/16351249/vba-check-if-file-exists

那么应该完成交易 - 或者你是说你不想自己做简单的编码?我的意思是我接受了它,因为你只是坚持如何不是如何的语法。有一点时间我可以很容易地将上面的内容翻译成实际的代码,但后来我觉得你也可以这样做,我更喜欢教一个钓鱼而不只是给你一条鱼。