繁体   English   中英

Excel VBA 根据第二列单元格值将列从一张表复制到另一张表

[英]Excel VBA to Copy Column from one sheet to another based on a second columns cell value

我试过这个,它返回了我想要的行,所以一个好的开始。 但我真的只需要 B 列中的值,而不是整行。 如果 C 列中的值是 <>"" 并且 D 列 <>"",我真正想要的是列出 B 列中的值。 结果报价单从单元格 C4 开始。

Sub CopyQuoteValues()
    Dim xRg As Range
    Dim xCell As Range
    Dim A As Long
    Dim B As Long
    Dim C As Long
    A = Worksheets("Software Options").UsedRange.Rows.Count
    B = Worksheets("Quote").UsedRange.Rows.Count
    If B = 1 Then
    If Application.WorksheetFunction.CountA(Worksheets("Quote").UsedRange) = 0 Then B = 0
    End If
    Set xRg = Worksheets("Software Options").Range("C17:C" & A)
    On Error Resume Next
    Application.ScreenUpdating = False
    For C = 1 To xRg.Count
        If CStr(xRg(C).Value) <> "" Then
            xRg(C).EntireRow.Copy Destination:=Worksheets("Quote").Range("A" & B + 1)
            B = B + 1
        End If
    Next
    Application.ScreenUpdating = True
End Sub

像这样的东西应该做你需要的:

Sub CopyQuoteValues()

    Dim wsOpt As Worksheet, wsQuote As Worksheet
    Dim c As Range, rngDest As Range
    
    Set wsOpt = Worksheets("Software Options")
    Set wsQuote = Worksheets("Quote")
    
    Set rngDest = wsQuote.Range("C4")
    
    For Each c In wsOpt.Range("C17", wsOpt.Cells(wsOpt.Rows.Count, "C").End(xlUp)).Cells
        If Len(c.Value) > 0 And Len(c.Offset(0, 1)) > 0 Then 'value in C and D ?
            c.Offset(0, -1).Copy rngDest       'copy ColB
            Set rngDest = rngDest.Offset(1, 0) 'next paste location
        End If
    Next c
    
End Sub

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM