Question

我需要根据编号格式将数据从1 excel移动到另一个excel。举个例子，我按照以下方式对test1 excel进行了示例：

test1.xlsx

EName| Sal    | ID | Tel | Add     | Depart     | Pos      | 
------------------------------------------------------------
John | 10000  | 123| NA  | NY      | Finance    | Manager  |
------------------------------------------------------------
  1  |    5   |  2 |     |         |    3       |   4      |

列数字排列。在这种情况下，我需要将我的数据移动到另一个excel test2并以编号格式粘贴。

test.xlsx

Name  | ID | Department |  Level     |Position | Salary |
  1   |  2 |     3      |            |   4     |   5    |
John  | 123| Fiinanace  |    NA      |Manager  | 10000  |

由数字标识的每列的值。我如何实现这一目标。任何建议/参考都非常感谢。感谢

Sub startGenerateExcel()
Path1 = Range("F4").Value
Path2 = Range("F6").Value

Dim wbSource As Workbook
Dim wbDest As Workbook
Dim rngSource As Range
Dim rngDest As Range
Dim colNum As Integer
Dim colDest As Integer
Dim cl As Range

Set wbSource = Workbooks(Path1)
Set wbDest = Workbooks(Path2)

Set rngSource = wbSource.Sheets("Sheet1").Range("A1:G3") 'Modify as needed
Set rngDest = wbDest.Sheets("Sheet1").Range("A1:F3") 'Modify as needed

For Each cl In rngSource.Rows(2)
    colNum = cl.Offset(1, 0).Value
    colDest = Application.Match(colNum, rngDest.Rows(3), False)
    rngDest.Cells(2, colDest).Value = cl.Value
Next
End Sub

Answer 1

这没有经过测试，但从根本上说是很好的。我使用Match函数来做这种事情。您必须根据具体目的进行调整，即假设您的表格不仅仅是3行等等。

Sub TransferValuesUsingMatch()

Dim wbSource as Workbook
Dim wbDest as Workbook
Dim rngSource as Range
Dim rngDest as Range
Dim colNum as Integer
Dim colDest as Integer
Dim cl as Range

Set wbSource = Workbooks("test1.xlsx") 'Assumes the workbook is already open
Set wbDest = Workbooks("test.xlsx") 'Assumes the workbook is already open
Set rngSource = wbSource.Sheets("Sheet1").Range("A1:G3") 'Modify as needed
Set rngDest = wbDest.Sheets("Sheet1").Range("A1:F3") 'Modify as needed

For each cl in rngSource.Rows(2) 
    colNum = cl.Offset(1,0).Value
    colDest = Application.Match(colNum, rngDest.Rows(3), False)
    rngDest.Cells(2,colDest).Value = cl.Value
Next

End Sub

Answer 2

我不确定您是否要重新排列行，或者您的示例是否只有插图的数字，但我假设您只是想根据标题行中的名称移动数据列。 / p>

我喜欢从Excel工作表中提取数据并将数据放入数组中。对数据执行某些操作，然后将其放回Excel工作表中。它比在单元格中工作更快，在这种情况下它可以很好地工作。有关如何执行此操作的示例代码，请参阅http://www.cpearson.com/excel/ArraysAndRanges.aspx。

您可以将每列放入其自己的数组中，然后使用位置（1,1）中的值在目标文件中重新排列它们。如果存在包含订购信息的不同行，您可以调整该位置以满足您的需求。

Answer 3

请尝试以下代码。

它将“旧”工作表中的数据读入数组，将重新排列的数据写入新数组，然后将新数组的值分配给“新”工作表。

Sub CopyAndRearrange()

    Dim oldWkb As Workbook, newWkb As Workbook
    Dim oldRange As Range, newRange As Range
    Dim oldArr(), newArr()

    'Assume data are in Sheet1 in oldWkb and need to go to Sheet1 in newWkb
    'and that both workbooks are open
    Set oldWkb = Workbooks("aWkb.xlsm")
    Set newWkb = Workbooks("anotherWkb.xlsm")
    Set oldRange = oldWkb.Worksheets(1).Range("A2:G11")
    Set newRange = newWkb.Worksheets(1).Range("A2:F11")
    Dim i As Long, j As Long

'   Assume data have fixed, known dimensions
    ReDim oldArray(1 To 10, 1 To 7)
    oldArray = oldRange
    ReDim newArray(1 To 10, 1 To 6)
    For i = 1 To 10
        For j = 1 To 6
            Select Case j
                Case 1
                    newArray(i, 1) = oldArray(i, 1)  '1->1
                Case 2
                    newArray(i, 6) = oldArray(i, 2)  '2->6
                    Debug.Print newArray(i, 6)
                Case 3
                    newArray(i, 2) = oldArray(i, 3)  '3->2                      
                Case 4
                    newArray(i, 3) = oldArray(i, j + 2)  '6->3
                Case 5
                    newArray(i, 5) = oldArray(i, j + 2)  '7->5
                Case 6
                    newArray(i, 4) = "NA"                'NA->4
            End Select
        Next j
    Next i
    newRange.Value = newArray

End Sub

Answer 4

我的代码，将For ... Next替换为：

For Each cl In rngSource.Rows 'Handle whole row at once!
    rngDest.Cells(cl.Row, 1).Resize(, 6) = Array(cl.Cells(, 1), cl.Cells(1, 3), cl.Cells(1, 6), Empty, cl.Cells(1, 7), cl.Cells(1, 2))
Next

Excel VBA - 根据编号移动数据

4 个答案: