从Excel中的第4列复制数据

时间:2018-11-27 07:31:09

标签: excel vba excel-vba

我在Sheet1中有100列以上的原始数据,我需要在Sheet 2中每第4列进行复制。我尝试了Cell链接,只是想知道excel中是否有任何公式可以执行此活动。

工作表1和工作表2的屏幕截图。

enter image description here

enter image description here

在这方面的任何帮助都将不胜感激。

4 个答案:

答案 0 :(得分:2)

这对于行和列都是动态的。

这假设两张纸上的Column A可以很好地指示最后一行的位置。


Sub Columns()

Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Sheet1")
Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets("Sheet2")

Dim LR As Long, LC As Long, LR2 As Long, Counter As Long, CopyRange As Range

LR = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row
LC = ws1.Cells(1, ws1.Columns.Count).End(xlToLeft).Column
LR2 = ws2.Range("A" & ws2.Rows.Count).End(xlUp).Offset(1).Row
Counter = 1

Application.ScreenUpdating = False
    For i = 1 To LC Step 3
        ws1.Range(ws1.Cells(2, i), ws1.Cells(LR, i)).Copy
        ws2.Cells(LR2, Counter).PasteSpecial xlPasteValues
        Counter = Counter + 1
    Next i
Application.ScreenUpdating = True

End Sub

答案 1 :(得分:1)

也许检查偏移量。它适用于行和列 https://exceljet.net/formula/copy-value-from-every-nth-column

答案 2 :(得分:1)

您可以使用公式来执行此操作,其基本格式为import re body = re.findall(r"\[\s*(.+)\s*]", my_list[0])[0] # extract the stuff in []s names = re.split("\s*,\s*", body) # extract the names #['James', 'Williams', 'Kevin', 'Parker', 'Alex', 'Emma', 'Katie', 'Annie'] ,但这意味着您必须根据需要将其复制下来,以覆盖整个范围。一种更永久的解决方案是使用VBA。

答案 3 :(得分:1)

尝试:

Option Explicit

Sub test()

    Dim LR As Long
    Dim LC As Long
    Dim LC2 As Long
    Dim i As Long

    With Worksheets("Sheet1")

        LC = .Cells(1, .Columns.Count).End(xlToLeft).Column

        For i = 1 To LC Step 3
            LR = .Cells(Rows.Count, i).End(xlUp).Row
            LC2 = Sheet2.Cells(1, Sheet2.Columns.Count).End(xlToLeft).Column

            If LC2 = 1 And Sheet2.Range("A1").Value = "" Then
                .Range(.Cells(1, i), .Cells(LR, i)).Copy
                    Sheet2.Cells(1, LC2).PasteSpecial Paste:=xlPasteFormulas
            Else: .Range(.Cells(1, i), .Cells(LR, i)).Copy
                    Sheet2.Cells(1, LC2 + 1).PasteSpecial Paste:=xlPasteFormulas
            End If
        Next i

    End With

End Sub