join三个代码“打开对话框”“剪切并粘贴”和“分割列重命名”

我希望你能帮上忙。 我有以下三段代码。 三者完全相互独立。 一切编译macros只是不会正确执行。

第一块代码Sub Open_Workbook_Dialog()打开一个对话框，并允许用户select一个文件。

第二段代码Public Sub Sample()search文本“CountryCode”的列标题，然后剪切该列并将其粘贴到F列中。

第三部分代码Public Sub Filter()获取列F并将其拆分为新的工作表并重命名基于国家/地区的工作表。

所以基本上macros应该做的是打开一个对话框获取文件，find它的国家列，将其剪切并粘贴到列F，然后将此列分割成新的表格和重命名。

就像我说的所有的代码独立工作，但是当我把它们放在一起。 对话框打开我select我的文件，然后我得到Msgbox “Country not Found”，即使Set aCell = .Range("A1:X50")列在范围内我想 Set aCell = .Range("A1:X50") CountryCode在列W.

一旦我单击MsgBox “国家找不到” Public Sub Filter()执行并拆分并重命名错误的列。 发现似乎没有发生，因此剪切和粘贴不会发生。

为了更好的理解，我附上照片。

国家未find

被错误的F分割

下面的代码

 Sub Open_Workbook_Dialog() Dim my_FileName As Variant MsgBox "Pick your TOV file" '<--| txt box for prompt to pick a file my_FileName = Application.GetOpenFilename(FileFilter:="Excel Files,*.xl*;*.xm*") '<--| Opens the file window to allow selection If my_FileName <> False Then Workbooks.Open Filename:=my_FileName Call Sample '<--|Calls the Filter Code and executes Call Filter '<--|Calls the Filter Code and executes End If End Sub Public Sub Sample() Dim ws As Worksheet Dim aCell As Range, Rng As Range Dim col As Long, lRow As Long Dim colName As String '~~> Change this to the relevant sheet Set ws = ThisWorkbook.Sheets("Sheet1") With ws Set aCell = .Range("A1:X50").Find(What:="CountryCode", LookIn:=xlValues, LookAt:=xlWhole, _ MatchCase:=False, SearchFormat:=False) '~~> If Found If Not aCell Is Nothing Then '~~> Cut the entire column aCell.EntireColumn.Cut '~~> Insert the column here Columns("F:F").Insert Shift:=xlToRight Else MsgBox "Country Not Found" End If End With End Sub Public Sub Filter() Dim rCountry As Range, helpCol As Range With Worksheets("Sheet1") '<--| refer to data worksheet With .UsedRange Set helpCol = .Resize(1, 1).Offset(, .Columns.Count) '<--| get a "helper" column just at the right of used range, it'll be used to store unique country names in End With With .Range("A1:Q" & .Cells(.Rows.Count, 1).End(xlUp).Row) '<--| refer to its columns "A:Q" from row 1 to last non empty row of column "A" .Columns(6).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=helpCol, Unique:=True '<-- call AdvancedFilter on 6th column of the referenced range and store its unique values in "helper" column Set helpCol = Range(helpCol.Offset(1), helpCol.End(xlDown)) '<--| set range with unique names in (skip header row) For Each rCountry In helpCol '<--| iterate over unique country names range (skip header row) .AutoFilter 6, rCountry.Value2 '<--| filter data on country field (6th column) with current unique country name If Application.WorksheetFunction.Subtotal(103, .Cells.Resize(, 1)) > 1 Then '<--| if any cell other than header ones has been filtered... Worksheets.Add Worksheets(Worksheets.Count) '<--... add new sheet ActiveSheet.Name = rCountry.Value2 '<--... rename it .SpecialCells(xlCellTypeVisible).Copy ActiveSheet.Range("A1") 'copy data for country under header End If Next End With .AutoFilterMode = False '<--| remove autofilter and show all rows back End With helpCol.Offset(-1).End(xlDown).Clear '<--| clear helper column (header included) End Sub 

Answer 1

问题是，您没有在打开的工作簿中search“CountryCode”，而是在工作簿中运行代码。 所以基本上你有一个工作簿，在这里你开始你的macros代码，并打开你想要使用的另一个工作簿（通过使用你的对话框）。 但是在你的Public Sub Sample()你的问题是这样的：

 Set ws = ThisWorkbook.Sheets("Sheet1") 

问题是，您正在引用工作簿，在其中您的macros代码编写和执行通过使用ThisWorkbook 。 既然你不知道你的Public Sub Sample()的文件名。 我已经编辑你的代码，以它应该的方式工作：

 Sub Open_Workbook_Dialog() Dim my_FileName As Variant Dim my_Workbook As Workbook MsgBox "Pick your TOV file" '<--| txt box for prompt to pick a file my_FileName = Application.GetOpenFilename(FileFilter:="Excel Files,*.xl*;*.xm*") '<--| Opens the file window to allow selection If my_FileName <> False Then Set my_Workbook = Workbooks.Open(Filename:=my_FileName) Call Sample(my_Workbook)'<--|Calls the Filter Code and executes Call Filter(my_Workbook) '<--|Calls the Filter Code and executes End If End Sub Public Sub Sample(my_Workbook as Workbook) Dim ws As Worksheet Dim aCell As Range, Rng As Range Dim col As Long, lRow As Long Dim colName As String '~~> Change this to the relevant sheet Set ws = my_Workbook.Sheets("Sheet1") With ws Set aCell = .Range("A1:X50").Find(What:="CountryCode", LookIn:=xlValues, LookAt:=xlWhole, _ MatchCase:=False, SearchFormat:=False) '~~> If Found If Not aCell Is Nothing Then '~~> Cut the entire column aCell.EntireColumn.Cut '~~> Insert the column here Columns("F:F").Insert Shift:=xlToRight Else MsgBox "Country Not Found" End If End With End Sub Public Sub Filter(my_Workbook as Workbook) Dim rCountry As Range, helpCol As Range With my_Workbook.Worksheets("Sheet1") '<--| refer to data worksheet With .UsedRange Set helpCol = .Resize(1, 1).Offset(, .Columns.Count) '<--| get a "helper" column just at the right of used range, it'll be used to store unique country names in End With With .Range("A1:Q" & .Cells(.Rows.Count, 1).End(xlUp).Row) '<--| refer to its columns "A:Q" from row 1 to last non empty row of column "A" .Columns(6).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=helpCol, Unique:=True '<-- call AdvancedFilter on 6th column of the referenced range and store its unique values in "helper" column Set helpCol = Range(helpCol.Offset(1), helpCol.End(xlDown)) '<--| set range with unique names in (skip header row) For Each rCountry In helpCol '<--| iterate over unique country names range (skip header row) .AutoFilter 6, rCountry.Value2 '<--| filter data on country field (6th column) with current unique country name If Application.WorksheetFunction.Subtotal(103, .Cells.Resize(, 1)) > 1 Then '<--| if any cell other than header ones has been filtered... Worksheets.Add Worksheets(Worksheets.Count) '<--... add new sheet ActiveSheet.Name = rCountry.Value2 '<--... rename it .SpecialCells(xlCellTypeVisible).Copy ActiveSheet.Range("A1") 'copy data for country under header End If Next End With .AutoFilterMode = False '<--| remove autofilter and show all rows back End With helpCol.Offset(-1).End(xlDown).Clear '<--| clear helper column (header included) End Sub 

您可能还想将.Sheets("Sheet1") （或.Worksheets("Sheet1") ）的行更改为.Sheets(1) （或.Worksheets(1) ），因此您不必依赖打开的工作簿。

Answer 2

在设置一个Cellvariables时，在你的行中包含具有CountryCode的列（在这种情况下为W列）。

Answer 3

这很可能是一个参考问题。

用简单的英语，这意味着你没有通过新打开的工作簿的参考，因此你的其他Subs不知道你正在谈论哪一个！

我已经做了一个例子，告诉你在哪里做出改变：

 Sub Open_Workbook_Dialog() Dim my_FileName As Variant '~~> Changes here Dim MainWbk As Workbook Dim OpenedWbk As Workbook '~~> Changes here Set MainWbk = ThisWorkbook MsgBox "Pick your TOV file" my_FileName = Application.GetOpenFilename(FileFilter:="Excel Files,*.xl*;*.xm*") If my_FileName <> False Then '~~> Changes here Set OpenedWbk = Workbooks.Open(Filename:=my_FileName) '~~> Changes here Call Sample(OpenedWbk, MainWbk) ''~~> Same changes to do here 'Call Filter End If End Sub '~~> Changes here (arguments to pass the references of the workbooks) Public Sub Sample(OpenedWbk As Workbook, MainWbk As Workbook) Dim ws As Worksheet Dim aCell As Range, Rng As Range Dim col As Long, lRow As Long Dim colName As String '~~> Changes here Set ws = OpenedWbk.Sheets("Sheet1") With ws Set aCell = .Range("A1:X50").Find(What:="CountryCode", _ LookIn:=xlValues, LookAt:=xlWhole, _ MatchCase:=False, SearchFormat:=False) If Not aCell Is Nothing Then aCell.EntireColumn.Cut '~~> Changes here MainWbk.Columns("F:F").Insert Shift:=xlToRight Else MsgBox "Country Not Found" End If End With End Sub