Question

序言：我是自学成才的任何VB脚本。我发现的大多数东西都是我发现的大杂烩脚本。

我需要根据一组单元格值将行排序到不同的工作表中。在某些情况下，它是一组适用的数字，在其他情况下，这是一个非常直接的价值。

请参阅：单元格值1-99将转到标题为“1-99”的工作表单元格值100将转到标题为“100”的工作表

有几个这样的范围。工作迭代我只适用于直接值。基本上，如何使脚本理解小于或大于或两者 - 对于它在集合之间的实例（参见：101-199）？

Set Sorter = Sheets("Raw Data").Range("M2:M100000")
For Each cell In Sorter

If cell.Value = "100" Then
cell.EntireRow.Copy
Sheets("100").Range("C" & Rows.Count).End(xlUp).Offset(1, -2).PasteSpecial
If cell.Value = "200" Then
cell.EntireRow.Copy
Sheets("200").Range("C" & Rows.Count).End(xlUp).Offset(1, -2).PasteSpecial
End If
Next
Application.CutCopyMode = False

感谢您的帮助。

编辑：

以下是范围： 1-99 100 101-199 200 201-299 300

Answer 1

未测试：

Dim v, s

Set Sorter = Sheets("Raw Data").Range("M2:M100000")

For Each cell In Sorter
    v = cell.Value

    if Len(v) > 0 And Isnumeric(v) Then

        If v>1 and v<=99 Then
            s = "1-99"
        Elseif v = 100 Then
            s = "100"
        Else
            s = ""
        End If

        If s<>"" Then 
           Sheets(s).Range("C" & Rows.Count).End(xlUp).Offset(1,0).Entirerow.Value = _
                            c.entirerow.Value
        End if
     End if       
Next

Answer 2

我有一个适合你的解决方案，可以在VBA中向你展示一些好的概念。

PREP FROM YOU：

创建名为“1-99”，“100”，“101-199”，“200”，“201-299”，“300”的工作表

包括标题行，我编写的代码在第2行中起作用，因此如果标题占用的数量多于此，则只需修改初始化部分。

将此代码复制到模块中并运行它。

流程：

初始化所有工作表的行号和名称

循环“原始数据”并获取要评估的tempValue。

使用SELECT CASE语句，确定哪些行转到哪些表。

将一些参数传递给一个sub，它将相应地移动数据，节省空间和理智。

注意：我不确定您的列是否具有要检查的值，它看起来像“M”，所以这就是我正在使用的。如果它是“A”你可以改变它，让我知道，我会修改答案。

<强>试验：

Sub SortValuesToSheets()

Dim lastRow As Long
Dim lastCol As Long
Dim tempValue As Double         'Using Double not knowing what kind of numbers you are evaluating
Dim lRow As Long

Dim sh1 As String, sh2 As String, sh3 As String
Dim sh4 As String, sh5 As String, sh6 As String
Dim raw As String

Dim sh1Row As Long, sh2Row As Long, sh3Row As Long
Dim sh4Row As Long, sh5Row As Long, sh6Row As Long

'INITIALIZE TARGET SHEETS
    'Name the target sheets
    raw = "Raw Data"
    sh1 = "1-99"
    sh2 = "100"
    sh3 = "101-199"
    sh4 = "200"
    sh5 = "201-299"
    sh6 = "300"

    'Set the row number for each target sheet to 2, to account for headers
    sh1Row = 2
    sh2Row = 2
    sh3Row = 2
    sh4Row = 2
    sh5Row = 2
    sh6Row = 2

    lastRow = Sheets(raw).Cells(Rows.Count, "A").End(xlUp).row           'Get the last Row
    lastCol = Sheets(raw).Cells(2, Columns.Count).End(xlToLeft).Column   'and column

    'BEGIN LOOP THROUGH RAW DATA
    For lRow = 2 To lastRow
        tempValue = CDbl(Sheets(raw).Cells(lRow, "M").Value)        'set TempValue to SEARCH COLUMN

        Select Case tempValue
            Case Is < 1
                MsgBox ("Out of Range, Under 1")
            Case 1 To 99
                Call CopyTempRow(lRow, sh1, sh1Row, lastCol)
                sh1Row = sh1Row + 1
            Case 100
                Call CopyTempRow(lRow, sh2, sh2Row, lastCol)
                sh2Row = sh2Row + 1
            Case 101 - 199
                Call CopyTempRow(lRow, sh3, sh3Row, lastCol)
                sh3Row = sh3Row + 1
            Case 200
                Call CopyTempRow(lRow, sh4, sh4Row, lastCol)
                sh4Row = sh4Row + 1
            Case 201 - 299
                Call CopyTempRow(lRow, sh5, sh5Row, lastCol)
                sh5Row = sh5Row + 1
            Case 300
                Call CopyTempRow(lRow, sh6, sh6Row, lastCol)
                sh6Row = sh6Row + 1
            Case Is > 300
                MsgBox ("Out of Range, Over 300")
        End Select
    Next lRow

End Sub

这是将复制整行的子程序。将它分开的原因是我们不必为每个案例重新编写稍有变化的内容。您不希望看到此循环6次，每次只更改一个数字。如果你必须更改它，你可以在这里更改一次，并在需要时随时调用它。

Sub CopyTempRow(row As Long, target As String, tRow As Long, lastCol As Long)

    For lCol = 1 To lastCol
        Sheets(target).Cells(tRow, lCol) = Sheets("Raw Data").Cells(row, lCol)
    Next lCol

End Sub

根据单元格值将行排序为新工作表

2 个答案: