Question

我在sheet1（Export）中有下表：

-----------------------------
| 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的存在表中。

谢谢！

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

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

1 个答案: