Question

所有

我是这里的VBA新手，我的任务是在我的新工作中开发一些宏。目前，我正在开发一个宏，它通过一个文本文件，应用一些格式，隔离所需的数字数据，复制它，然后将复制的信息输出到一个新的工作表。

这是格式化的代码，只是为了确保我发布它：

`Perform Text-To-Columns on Column A. Delimited by the character "#"
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
    :="#", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True

`Perform Text-To-Columns on Column B. Delimited by the character ")"
Columns("B:B").Select
Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
    :=")", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True

`Format Column B for Numbers to have zero decimal places
Selection.NumberFormat = "0"

`Filter Column B for all numbers greater than 500
Selection.AutoFilter
ActiveSheet.Range("$B$1:$B$1720").AutoFilter Field:=1, Criteria1:=">500", _
    Operator:=xlAnd

`Sort Filtered numbers from lowest to highest
ActiveWorkbook.Worksheets(1).Sort.SortFields.Clear
ActiveWorkbook.Worksheets(1).Sort.SortFields.Add Key:=Range( _
    "B1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
With ActiveWorkbook.Worksheets(1).Sort
    .SetRange Range("B1").EntireColumn
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

此时，我现在有B列，其中12位数字的数量因文件而异。宏的下一部分是一个现在应该查看此B列的循环，并开始检查B列的单元格以查看它们是否包含12位数字，如果是，则开始将它们复制为范围。一旦找到B中的所有12位数字，就应该将它们全部复制，打开一个新标签，然后粘贴结果：

' Declare loop variables
    Dim myLastRow As Long
    Dim myRow As Long
    Dim i As Long
    Dim myValue As String
    Dim myStartRow As Long
    Dim myEndRow As Long

'   Find last row with data in column B
    myLastRow = Cells(Rows.Count, "B").End(xlUp).Row

'   Loop through all data in column B until you find a 12 order number Number
    For myRow = 1 To myLastRow
'       If 12 digit entry is found, capture the row number,
'       then go down until you find the first entry not 12 digits long
        If (Len(Cells(myRow, "B")) = 12) And (IsNumeric(Cells(myRow, "B"))) Then
            myStartRow = myRow
            i = 1
            Do
                If Len(Cells(myRow + i, "B")) <> 12 Then
'               If found, capture row number of the last 13 digit cell
                    myEndRow = myRow + i - 1
'                   Copy the selected data
                    Range(Cells(myStartRow, "B"), Cells(myEndRow, "B")).Copy
'                   Add "Results" as a new sheet for the copied Card Numbers to be pasted into
                    Sheets.Add.Name = "Results"
                    Sheets("Results").Activate
'                   Paste clipboard to "Results" and format the results for viewing
                    Range("A1").Select
                    ActiveSheet.Paste
                    Columns("A:A").EntireColumn.AutoFit
                    Application.CutCopyMode = False
                    Exit Do
                Else
'               Otherwise, move row counter down one and continue
                    i = i + 1
                End If
            Loop
            Exit For
        End If
    Next myRow

无论出于何种原因，当我浏览宏时，它所做的就是捕获B1中的第一个值，然后将其放入结果表中。我不能为我的生活找出原因。可能是因为我申请的过滤？如果有人能给我一些见解，我会全力以赴。非常感谢您提供的任何帮助。

Answer 1

这是一个相当简单的代码，似乎有效。希望它符合您的需求：

<div class="footer">
  <div class="container">
    <div class="col-sm-8 left">
      left section, list items
    </div>
    <div class="col-sm-4 newsletter">
      newsletter section
    </div>
  </div>
</div>

.footer {
  background: linear-gradient(90deg, #ffffff 50%, #ff0000 50%);
}

.left {
  background: #ffffff;
}

.newsletter {
  background: #ff0000;
}

Answer 2

我不确定，但你可以试试这个：

Option Explicit

Sub CopyNumber()

Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Sheet1") 'Change the name of the sheet
Dim Result As Worksheet

Dim ws1Lastrow As Long, LastrowResult As Long
Dim i As Long, Rng As Range
Dim TestLenght, Arr

Sheets.Add.Name = "Results" ' Add your new sheet
Set Result = ThisWorkbook.Sheets("Results")

With ws1

    ws1Lastrow = .Range("B" & Rows.Count).End(xlUp).Row 'Find the lastrow in the Source Data Sheet
    Set Rng = .Range("B1:B" & ws1Lastrow) 'Set your range to put into your Array
    Arr = Rng.Value

For i = LBound(Arr) To UBound(Arr)

    TestLenght = Arr(i, 1)

            If Len(Trim(TestLenght)) = 12 And IsNumeric(TestLenght) Then ' Test your data

                    LastrowResult = Result.Range("A" & Rows.Count).End(xlUp).Row + 1
                    Result.Cells(LastrowResult, "A") = TestLenght ' Past your data from your array to the Result Sheet

            End If

Next ' next data of the Array

End With

End Sub

Answer 3

我认为问题可能是将数字格式化为显示0位小数与截断它们不同。 Len（）函数将对单元格的实际内容（或真值）进行操作，而不是显示的值。因此，如果你对这些数字有小数，Len（）将返回一个大于12的值，因为它会计算小数位和小数。

如果这是问题，您需要舍入到0小数位（或截断为整数），以强制实际单元格内容的长度为12.

VBA宏循环仅复制一个数据单元而不是许多

3 个答案: