Question

因此，我尝试在E列中获取以下（重复）唯一值（5678、8563、5636、1231），以将每个值添加到新的电子表格中。如果我在数字前按“ XXXX-XXXXX-”之类的名称进行操作，则下面的代码可以正常工作，但是当我剥离掉“ XXXX-XXXXX-”后，它停止工作了，为什么有什么主意？

Sub newworksheet()

' Creates worksheets per account number
Dim d As Range, Rng As Range, It As Range, k, nr As Long
Application.ScreenUpdating = False
With Worksheets("Sheet1")
  Set Rng = .Range(Range("E2"), .Range("E" & Rows.Count).End(xlUp))
  With CreateObject("Scripting.Dictionary")
    .CompareMode = vbBinaryCompare
    For Each d In Rng
      If Not .Exists(d.Value) Then
        .Add d.Value, d.Resize(, 12)
      Else
        Set .Item(d.Value) = Union(.Item(d.Value), d.Resize(, 12))
      End If
    Next
    For Each k In .keys
      For Each It In .Item(k).Areas
        If Not Evaluate("ISREF(" & k & "!E1)") Then Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = k
        nr = Worksheets(k).Range("E" & Rows.Count).End(xlUp).Offset().Row
        Sheets(k).Range("E" & nr).Resize(It.Rows.Count, 12) = It.Value
      Next It
      Sheets(k).Cells.EntireColumn.AutoFit
    Next k
  End With
End With
Application.ScreenUpdating = True

结束子

Answer 1

为此（和类似的通话）-

Sheets(k).Cells.EntireColumn.AutoFit

如果k是一个数字，则要求提供（例如）第5678页。

Sheets(CStr(k)).Cells.EntireColumn.AutoFit

此版本对我有用：

Sub newworksheet()

    ' Creates worksheets per account number
    Dim d As Range, Rng As Range, It As Range, k, nr As Long, sht As Worksheet

    Application.ScreenUpdating = False

    With Worksheets("Sheet1")
        Set Rng = .Range(.Range("E2"), .Range("E" & Rows.Count).End(xlUp))
    End With

    With CreateObject("Scripting.Dictionary")
        .CompareMode = vbBinaryCompare

        For Each d In Rng
            If Not .Exists(d.Value) Then
              .Add d.Value, d.Resize(, 12)
            Else
              Set .Item(d.Value) = Union(.Item(d.Value), d.Resize(, 12))
            End If
        Next

        For Each k In .keys

            If Not Evaluate("ISREF(" & k & "!E1)") Then _
                 Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = k
            Set sht = Worksheets(CStr(k))

            For Each It In .Item(k).Areas
                nr = sht.Range("E" & sht.Rows.Count).End(xlUp).Offset(1, 0).Row
                sht.Range("E" & nr).Resize(It.Rows.Count, 12) = It.Value
            Next It
            sht.Cells.EntireColumn.AutoFit
        Next k
    End With


Application.ScreenUpdating = True
End Sub

用于识别的唯一值的新工作表仅用于文本值

1 个答案: