1

我需要根据编号格式将数据从 1 个 excel 移动到另一个 excel。例如，我按照以下示例 test1 excel：

测试1.xlsx

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

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

测试.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
4

4 回答 4

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
于 2013-07-26T03:36:55.857 回答
0

我的代码，替换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
于 2013-07-26T09:21:08.663 回答
0

我不确定您是否也想重新排列行，或者您的示例是否仅具有用于说明的数字，但我假设您只想根据标题行中的名称移动数据列。

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

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

于 2013-07-26T04:46:30.710 回答
0

试试下面的代码。

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

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
于 2013-07-26T05:13:43.763 回答