excel 复制/粘贴数据+遍历行

n9vozmp4 于 2023-03-04 发布在其他

关注(0)|答案(1)|浏览(160)

在表1中，A列是日期，B列（纬度）和C列（经度）是坐标。
在表2中，我有一个基于坐标的计算，它返回每个日期的日落时间。
如果有坐标，我想将纬度和经度都复制到工作表2的单元格B3中。
然后，我想Vlookup复制坐标的日期（在工作表1的A列中），以复制相应的日落时间并将其粘贴到工作表1的D列（经度旁边）。
对于数据集中的一个条目，它应该看起来像下面的例子吗？
那么，如何循环遍历表1中该表的34行？
它需要在有数据时这样做，避免空单元格。

Dim iRow&
Dim sRange$
Dim timetable As Range
Dim WS As Worksheet, WS2 As Worksheet

'set up worksheet variables
Set WS = ThisWorkbook.Sheets("Sheet1")
Set WS2 = ThisWorkbook.Sheets("Sheet2")

' defines the table returning the sunset time
Set timetable = WS2.Range("D2:Z368")

For iRow = 12 To 45
    If Not IsEmpty(WS.Cells(iRow, 45)) And Not IsEmpty(WS.Cells(iRow, 46)) Then
    WS.Range("AS" & iRow & ":AT" & iRow).Copy
    WS2.Range("B3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
      :=False, Transpose:=True
    End If
    
    sRange = "AU" & iRow
    'create formula for first cell
    WS.Range(sRange).Formula = "=IFERROR(IF(OR(AS" & iRow & "="""",AT" & iRow & "=""""),"""",VLOOKUP(AR" & iRow & ",Sheet2!D$2:Z$368,23,FALSE)),""Value missing from Sheet2 table"")"
    'remove formula
    WS.Range(sRange).Copy
    WS.Range(sRange).PasteSpecial (xlPasteValues)

第1页

第2页

更新代码的结果

excel

来源：https://stackoverflow.com/questions/73557085/copy-paste-data-loop-through-rows

1条答案

按热度按时间

0md85ypi1#

我已经清理了你原来的宏生成代码。我用直接插入到工作表中的公式替换了工作表函数，然后按要求将公式复制到其他33个单元格中。这简化了所需的VBA。我测试了它，它工作正常。
如果发生错误，Excel IFERROR函数将显示一条消息，在本例中，Sheet2上的表中缺少值

Option Explicit
    
    Private Sub Test()
    
    Dim iRow&
    Dim sRange$
    Dim timetable As Range
    Dim WS As Worksheet, WS2 As Worksheet
    
    'set up worksheet variables for cleaner, more easily readable code
    Set WS = ThisWorkbook.Sheets("Sheet1")
    Set WS2 = ThisWorkbook.Sheets("Sheet2")
    
    Set timetable = WS2.Range("D2:Z368")
    
    For iRow = 12 To 45
        If Not IsEmpty(WS.Cells(iRow, 45)) And Not IsEmpty(WS.Cells(iRow, 46)) Then
            WS.Range("AS" & iRow & ":AT" & iRow).Copy
            WS2.Range("B3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        End If
        
        'this is your modified original line of code
        'WS.Range("AU12") = Application.WorksheetFunction.VLookup(WS.Range("AR12"), timetable, 23, False)
        
        sRange = "AU" & iRow
        'create formula for first cell
        WS.Range(sRange).Formula = "=IFERROR(IF(OR(AS" & iRow & "="""",AT" & iRow & "=""""),"""",VLOOKUP(AR" & iRow & ",Sheet2!D$2:Z$368,23,FALSE)),""Value missing from Sheet2 table"")"
        'remove formula
        WS.Range(sRange).Copy
        WS.Range(sRange).PasteSpecial (xlPasteValues)
    Next
    
    'copy formula to the additional 33 cells as requested
    
    'WS.Range("AU12").Copy
    'WS.Range("AU12:AU45").PasteSpecial Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    
    End Sub

赞(0）回复(0）举报 2023-03-04

我来回答

excel 复制/粘贴数据+遍历行

1条答案

相关问题

热门标签

最新问答