Question

我想知道如何根据需要操作我的Excel数据。

我有一个包含行和很多字段的表我希望手动选择一些行并将它们复制到另一个预定义列的表中，这些行排序这些行以适合我的预定义列并为行创建唯一代码我认为重复基于2两列。

这可能不太清楚所以我会用照片解释更多：

这里我的表格中有我手工选择的行，我想将H，I，K，AA，AJ列复制到另一张表格中，但是按照一些特定的顺序排列我的其他表格列：

我希望我的AJ列在A栏中，我的AA列在列E中的列E我的列F等...

我还想根据列F和I创建一个唯一的密钥（例如，在第一个图像行17到21中，在B列的蓝色表中具有相同的密钥）

目前我能够获取所选行并将所需列复制到另一张表。

我不知道如何重新排序它们以适应第二张表格中的模板。我也不知道如何创建一个键并将其插入我的第二张表中，用于我的第一张表的F和I列的每个组合。

Sub ajout_commande()
Set DataSheet = ThisWorkbook.Worksheets("0")
Dim a As Range, b As Range
Set a = Selection

i = Selection.Rows.Count

For Each b In a.Rows
    DataSheet.Cells(2, 1).EntireRow.Insert
Next

Dim r1 As Range, r2 As Range, r3 As Rang, r4 As Range, r5 As Range, res_range As Range

Let copyrange1 = "I1" & ":" & "I" & i
Let copyrange2 = "K1" & ":" & "K" & i
Let copyrange3 = "L1" & ":" & "L" & i
Let copyrange4 = "AA1" & ":" & "AA" & i
Let copyrange5 = "AJ1" & ":" & "AJ" & i

Set r1 = a.Range(copyrange1)
Set r2 = a.Range(copyrange2)
Set r3 = a.Range(copyrange3)
Set r4 = a.Range(copyrange4)
Set r5 = a.Range(copyrange5)

Set res_range = Union(r1, r2, r3, r4, r5)

res_range.Copy
DataSheet.Cells(2, 1).PasteSpecial xlPasteValues

End Sub

如果要复制实现或不可能请在评论中告诉我，以便我尝试找到另一种方法。我是VBA的新手，正试图通过简化他们的工作来帮助我的同事。

感谢。

Answer 1

也许尝试这样的事情。
它需要一些调整（特别是在要复制的单元格中）

Dim UniqueKeyArray() As String
Dim Counter As Long

Sub test()

   Dim aRows As Range, aCell As Range
   Dim Ws As Worksheet
   Dim i As Long

   Set Ws = ThisWorkbook.Sheets("SomeName")
   ReDim UniqueKeyArray(0 To 1, 1 To 1)

   For i = 1 To Selection.Areas.Count 'loop through selection
       For Each aRows In Selection.Areas(i).Rows 'loop through rows of selection
           For Each bCell In aRows.Columns(1).Cells 'loop through cells in column one
               With Ws
                   .Cells(2, 1).EntireRow.Insert
                   'adjust offset to get source data you need
                   'adjust cells(x,y) to put data where you want it
                   .Cells(2, 2) = bCell.Offset(0, 2)
                   .Cells(2, 3) = bCell.Offset(0, 3)
                   .Cells(2, 4) = bCell.Offset(0, 5)
                   .Cells(2, 5) = bCell.Offset(0, 6)
                   .Cells(2, 1) = "'" & UniqueKey(bCell.Text) ' "'" added to prevent excel trim leading 000.. 
               End With
           Next bCell
       Next aRows
   Next i

'reset variables. This way you always start unique key from 1
   Counter = 0
   Erase UniqueKeyArray

End Sub

Function UniqueKey(SourceVal As String) As String
'creates unique key based on source string
   Dim i As Long

   For i = 1 To UBound(UniqueKeyArray, 2)
       If UniqueKeyArray(1, i) = Format(SourceVal, "0000000000") Then
       'if string is same you get unique key created before
           UniqueKey = UniqueKeyArray(1, i)
           Exit Function
       End If
   Next i

   'if string is new then new unique key is created
   Counter = Counter + 1
   ReDim Preserve UniqueKeyArray(0 To 1, 1 To Counter)
   UniqueKey = Format(Counter, "0000000000") 'adjust format to fit your needs
   UniqueKeyArray(0, Counter) = SourceVal
   UniqueKeyArray(1, Counter) = UniqueKey

End Function

将行复制到另一个工作表并为复制

1 个答案: