excel - excel - 根据值类型从表中复制值

Question

我在 sheet1（导出）中有下表：

-----------------------------
| col1 | col2 |..cN..|ctr_type|
-----------------------------
|value |value |valueN|CtrType1|
-----------------------------
|value |value |valueN|CtrType2|
-----------------------------
|value |value |valueN|CtrType3|
-----------------------------
|value |value |valueN|CtrType1|
-----------------------------
|value |value |valueN|CtrType3|
-----------------------------
|value |value |valueN|CtrType2|
-----------------------------

其中ctr_type是必须在其中复制传入值的工作表的名称。

所以我的问题是：如何在他们的传入表中复制值。

一个预期的输出是表中在 ctr_type 列中具有 CtrType1 的所有值将被复制到名为 CtrType1 的现有工作表中。

谢谢！

标签： excelexcel-formulaexcel-2013vba

Answer 1

可以使用类似下面的东西。假设您的数据具有标题并从第 1 列开始，并且表格右侧没有数据。否则，更改确定最后一列的方法。

我有帮助函数来查找最后一行和最后一列。我循环最后一列以获取存储在字典中的唯一工作表名称，同时将工作表名称左侧的范围添加到字典中。如果工作表名称作为字典中的键存在，我使用 Union 将左侧的当前范围添加到为此工作表名称找到的现有行。

我使用工作表名称键重新循环字典以将值写入适当的工作表。您应该添加错误处理，例如如果工作表不存在怎么办？

Option Explicit
Public Sub WriteValues()
    Dim rng As Range, ws As Worksheet, loopRange As Range, sheetDict As Object
    Set ws = ActiveSheet: Set sheetDict = CreateObject("Scripting.Dictionary")
    With ws
        Set loopRange = Range(.Cells(2, GetLastColumn(ws, 1)), .Cells(GetLastRow(ws, 1), GetLastColumn(ws, 1)))
        For Each rng In loopRange
            If Not sheetDict.Exists(rng.Value) Then
                Dim tempRange As Range
                Set tempRange = .Range(.Cells(rng.Row, 1), .Cells(rng.Row, GetLastColumn(ws, 1) - 1))
                sheetDict.Add rng.Value, tempRange.Address
            Else
                Set tempRange = Union(.Range(sheetDict(rng.Value)), .Range(.Cells(rng.Row, 1), .Cells(rng.Row, GetLastColumn(ws, 1) - 1)))
                sheetDict(rng.Value) = tempRange.Address
            End If
        Next rng
        For Each rng In loopRange
            Set tempRange = .Range(sheetDict(rng.Value))
            If Not tempRange Is Nothing Then
                tempRange.Copy Worksheets(rng.Value).Range("A" & GetLastRow(Worksheets(rng.Value), 1))
            End If
        Next rng
    End With
End Sub

Public Function GetLastColumn(ByVal ws As Worksheet, Optional ByVal rowNumber As Long = 1) As Long
    With ws
        GetLastColumn = .Cells(rowNumber, .Columns.Count).End(xlToLeft).Column
    End With
End Function

Public Function GetLastRow(ByVal ws As Worksheet, Optional ByVal columnNumber As Long = 1) As Long
    With ws
        GetLastRow = .Cells(.Rows.Count, columnNumber).End(xlUp).Row
    End With
End Function