Question

我有几个我需要匹配的excel文件。情况就是这样。

我得到了新数据所在的源文件。在这种情况下，数据在第59行，值（数字）从C59开始并水平移动直到CB59。有些值是特殊的，以粗体显示。然后我有另一个文件，（目标）。数据在D列，从D9开始并进入D675，但值是每9个单元格。（D19，D18，D27等）。它们完美匹配。

我想要一个宏来查找源文件中的值，并仅以粗体粘贴值。例如，如果我在源文件中的值为C59，D59，E59，F59，则目标文件中的等效值分别为D9，D18，D27，D36。但是，如果只有D59和E59的值为粗体，那么这些将是唯一复制到目标文件的值，在这种情况下，只有D18和D27的值才会改变。此外，如果复制，则必须是常规字母，而不是粗体。

感谢您的帮助。

更新：请丢弃大胆的数据。我刚发现我正在寻找所有复制的数据。我想请你支持正确粘贴第58行中的值，从I列到wbBook2中的CB列，并将它们粘贴到wbBook1中，从D36开始，每隔9个单元格。

我尝试了这段代码，它在wbBook 1 D36，D45和D54上粘贴了相同的wbBook2 I58值。然后每隔9天剩下的细胞都是空白的，突然它停在D243处。

添加代码

Sub Macroloco_()

Dim wbBook1 As Workbook

Dim wbBook2 As Workbook

Set wbBook1 = ThisWorkbook
Set wbBook2 = Workbooks.Open("C:\reports Sep\week38.xls")

Dim wsSheet1 As Worksheet
Dim wsSheet2 As Worksheet
Set wsSheet1 = wbBook1.Worksheets("01")
Set wsSheet2 = wbBook2.Worksheets("results")

Dim lastColumn As Long
Dim targetRow As Long
Dim i As Long

targetRow = 36

lastColumn = wsSheet2.Range("CB" & Columns.Count).End(xlUp).Column
For i = 58 To lastColumn
wsSheet2.Range("I" & i).Copy
wsSheet1.Range("D" & targetRow).PasteSpecial xlPasteAll

targetRow = targetRow + 9

Next i

End Sub

Answer 1

你有LastColumn寻找最后一行。

lastColumn = wsSheet2.Range("CB" & Columns.Count).End(xlUp).Column

应该是

With wsSheet2
    lastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With

修改

我的测试编号：

Sub fdsa() Dim i As Long, j As Long, k As Long With Sheets("Sheet1") j = .Cells(1, .Columns.Count).End(xlToLeft).Column k = 1 For i = 1 To j .Cells(i, 1).Copy Sheets("Sheet2").Cells(k, 4).PasteSpecial xlPasteAll k = k + 1 Next i End With End Sub

<强> EDIT2：

我在阅读时误解了。我正在遍历行并按行粘贴;你希望，类似于翻译，迭代列并粘贴成行。

在我的测试代码的基础上，只需要在副本行中将i从行移动到列：

Sub fdsa() Dim i As Long, j As Long, k As Long With Sheets("Sheet1") j = .Cells(1, .Columns.Count).End(xlToLeft).Column k = 1 For i = 1 To j .Cells(1, i).Copy 'changed to copy the iterating COLUMN Sheets("Sheet2").Cells(k, 4).PasteSpecial xlPasteAll 'Still pastes in every 9th ROW k = k + 1 Next i End With End Sub

确保从首选行开始，例如此测试代码遍历第1行中的列。

Answer 2

根据最后的回复，这是我正在尝试的新版本。

它仍然垂直复制（I58，I59，I60 ......）而不是水平复制（I58，J58，K58 ......）

我刚刚更改了引用，转到每个源和目标文件的正确列和单元格。

我相信j是复制行而不是列的行。我希望选择H列，用D和E计算公式，并复制和粘贴特殊。

UPDATE 此代码有效，但它会像输入最后一部分列（H：H）

一样停止

Sub Macroloco_()
Dim wbBook1 As Workbook
Dim wbBook2 As Workbook

Set wbBook1 = ThisWorkbook
Set wbBook2 = Workbooks.Open("C:\reports Sep\week38.xls")

Dim wsSheet1 As Worksheet
Dim wsSheet2 As Worksheet
Set wsSheet1 = wbBook1.Worksheets("01")
Set wsSheet2 = wbBook2.Worksheets("report")

Dim i As Long, j As Long, k As Long
With wsSheet2
    j = .Cells(1, .Columns.Count).End(xlToLeft).Column
    k = 36
    For i = 9 To j
        .Cells(58, i).Copy
        wsSheet1.Cells(k, 4).PasteSpecial xlPasteAll
        k = k + 9
    Next i
End With

Columns("H:H").Select
Selection.SpecialCells(xlCellTypeConstants, 1).Select
Selection.FormulaR1C1 = "=RC[-4]-RC[-3]"
Columns("H:H").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Columns("I:I").Select
Selection.SpecialCells(xlCellTypeConstants, 1).Select
Selection.ClearContents
Range("J9").Select
Application.CutCopyMode = False

End Sub

连续复制单元格并粘贴每个第n个单元格

2 个答案: