Question

我在网上找到了以下大部分代码，它对我来说很棒。我添加的部分是创建第二个范围rngUniques2以及使用该范围进行一些字符串操作。我遇到的问题是，当我尝试访问该范围时，除了第一次之外，它没有提取正确的值。我在想我正在使用计数器错误，但我无法弄清楚它。我知道范围中有正确的值，因为我做了For Each Cell调试打印。

Sub Extract_All_Data()

'this macro assumes that your first row of data is a header row.
'will copy all filtered rows from one worksheet, to another blank workbook
'each unique filtered value will be copied to it's own sheet

'Variables used by the macro
Dim wbOrig, wbDest As Workbook
Dim rngFilter As Range, rngUniques, rngUniques2 As Range
Dim cell As Range, counter As Integer
Dim xValue, OutValue As String

 ' Prompt user to choose file and open it
MsgBox "Please select the file that will be split."
strFileToOpen = Application.GetOpenFilename(Title:="Please select the file that will be split.", FileFilter:="Excel Files *.xls* (*.xls*),")

If strFileToOpen = "False" Then
    MsgBox "No file selected.", vbExclamation, "Sorry!"
    Exit Sub
Else
    Set wbOrig = Workbooks.Open(Filename:=strFileToOpen)
End If


Sheets("HTPN").Activate

' Set the filter range (from A1 to the last used cell in column A)
Set rngFilter = Range("A1", Range("A" & Rows.Count).End(xlUp))

Application.ScreenUpdating = False

With rngFilter

    ' Filter column A to show only one of each item (uniques) in column A
    .AdvancedFilter Action:=xlFilterInPlace, Unique:=True

    ' Set a variable to the Unique values (one for ClientID and one for Client Name)
    Set rngUniques = Range("A2", Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)
    Set rngUniques2 = Range("B2", Range("B" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)

    ' Clear the filter
    ActiveSheet.ShowAllData

End With

' Create a new workbook with a sheet for each unique value
Application.SheetsInNewWorkbook = rngUniques.Count
Set wbDest = Workbooks.Add
Application.SheetsInNewWorkbook = 3

' Filter, Copy, and Paste each unique to its' own sheet in the new workbook
For Each cell In rngUniques

    counter = counter + 1

    'NOTE - this filter is on column A (field:=1), to change
    'to a different column you need to change the field number
    rngFilter.AutoFilter field:=1, Criteria1:=cell.Value

    ' Copy and paste the filtered data to it's unique sheet
    rngFilter.Resize(, 30).SpecialCells(xlCellTypeVisible).Copy Destination:=wbDest.Sheets(counter).Range("A1")

    ' Name the destination sheet
    ' Strip Client name to extract the AU #
    xValue = rngUniques2(counter, 1).Value

    Debug.Print xValue

    OutValue = ""

    For xIndex = 1 To VBA.Len(xValue)
        If (VBA.Mid(xValue, xIndex, 1) <> "-") Then
                If VBA.IsNumeric(VBA.Mid(xValue, xIndex, 1)) Then
                    OutValue = OutValue & VBA.Mid(xValue, xIndex, 1)
                End If
        Else: Exit For
        End If
    Next

    wbDest.Sheets(counter).Name = cell.Value & " - " & OutValue
    wbDest.Sheets(counter).Cells.Columns.AutoFit

Next cell

rngFilter.Parent.AutoFilterMode = False
Application.ScreenUpdating = True    

End Sub

编辑解释

示例数据：

A B

1 A

2 B

3 C

4 D

程序将A列中每个唯一项的所有行复制到单独的选项卡，并尝试正确命名该选项卡。选项卡的命名导致了我的麻烦。我正在尝试使用以下格式获取选项卡名称＆＃34;值 - B值＆＃34;，因此对于上面的示例，将有四个名为的选项卡：

1 - A

2 - B

3 - C

4 - D

rngUniques包含A列中的唯一值，rngUniques2包含B列中的相应值。我试图从同一For Each循环中的两个范围读取，但它没有访问rngUniques2中的正确数据。例如，当我运行宏时，它会命名选项卡：

1 - A

2 - A

3 - B

4 - C

上面的小样本使它看起来只有一个项目关闭，但随着它的进展它会进一步消失。我的实际数据创建了110个单独的标签我假设错误来自我试图访问下面的数据的方式。

xValue = rngUniques2(counter, 1).Value

在不同范围内使用For Each循环时，如何浏览其他范围的数据？

Answer 1

好的，谢谢，最后一次编辑确实有所帮助。

最后的澄清：如果A栏中的文字总是如此，请说＆＃34; 2＆＃34;，B栏中的文字总是说，＆＃34; B＆＃34;？或者有时候ColumnA可能是2但B列可能是＆＃34; C＆＃34;？因为对我而言，我认为通过对rnguniques2进行任何检查都会使事情过于复杂。

假设列B对于每个唯一列A值是相同的，您可以删除对rnguniques2的所有引用，除了初始＆＃34; set =列B＆＃34;，然后在设置工作表的名称时， go＆＃34; rnguniques（counter，1）.value＆amp; ＆＃34; - ＆＃34; ＆安培; rnguniques（计数器，2）。价值＆＃34;

我无法在这里看到代码的这一部分：

xValue = rngUniques2(counter, 1).Value

Debug.Print xValue

OutValue = ""

For xIndex = 1 To VBA.Len(xValue)
    If (VBA.Mid(xValue, xIndex, 1) <> "-") Then
            If VBA.IsNumeric(VBA.Mid(xValue, xIndex, 1)) Then
                OutValue = OutValue & VBA.Mid(xValue, xIndex, 1)
            End If
    Else: Exit For
    End If
Next

Answer 2

我已经能够通过将A列和B列合并到A列中来强制使用它。

无法访问双范围

2 个答案: