Question

我试图搜索我的问题，但我发现的所有解决方案均不适用于我的情况。抱歉，我是VBA的新手。

我想要什么：我有一个带有规格（A）的工作簿和一个带有VBA代码（B）的工作簿。我的代码应打开工作簿A，然后查找3列（按名称），然后仅将值和可见行复制到工作簿B的表中。

问题在于代码确实复制了数据，但是具有隐藏的行。

Sub SpecUpload()
fname = GetFilePath() 'User chooses the file
If fname = "" Then Exit Sub    

Dim excel As excel.Application
Dim wb As excel.Workbook
Dim sht As excel.Worksheet
Dim V_row As Integer 'Table Title row number
Dim V_col As Integer 'first Column number 
Dim N_col As Integer 'second Column number
Dim Q_col As Integer 'third Column number
Dim N As Integer     'Counter, that helps to understand that all columns were found - when N=3, it's done

Set excel = CreateObject("excel.Application") ' opening Workbook A
excel.Visible = False
Set wb = excel.Workbooks.Open(fname)
Set sht = wb.Worksheets("Spec") 'target worksheet

sht.Activate
N = 0
For i = 1 To 4  'Try to find the columns by name
    For j = 1 To 10
        If (sht.Cells(i, j) = "V") Then
            V_row = i
            V_col = j
            N = N + 1
        ElseIf (sht.Cells(i, j) = "Name") Then      
            N_col = j
            N = N + 1
        ElseIf (sht.Cells(i, j) = "Q-ty") Then      
            Q_col = j
            N = N + 1
        Else
            If N = 3 Then
                Exit For
            End If
        End If
    Next j

    If N = 3 Then
        Exit For
    End If
Next i

For k = V_row + 1 To V_row + 5
If sht.Cells(k, V_col) = 3 Then BomStart = k '3 means the first row with data to copy
Next k

lr = sht.Cells(Rows.Count, V_col).End(xlUp).Row 
entr = lr - BomStart + 2 'specific to Workbook B

'trying copy and paste column 1
sht.Range(sht.Cells(BomStart, V_col), sht.Cells(lr, V_col)).SpecialCells(xlCellTypeVisible).Copy 
ThisWorkbook.Activate
Application.ScreenUpdating = 0
Application.EnableEvents = 0
Application.DisplayAlerts = 0
Sheets("Spec").Range("B2:B" & entr).PasteSpecial Paste:=xlPasteValues 

'trying to copy and paste column 2
wb.Activate
sht.Range(sht.Cells(BomStart, N_col), sht.Cells(lr, N_col)).SpecialCells(xlCellTypeVisible).Copy
ThisWorkbook.Activate
Sheets("Spec").Range("D2:D" & entr).PasteSpecial Paste:=xlPasteValues

'trying to copy and paste column 3
wb.Activate
sht.Range(sht.Cells(BomStart, Q_col), sht.Cells(lr, Q_col)).SpecialCells(xlCellTypeVisible).Copy
ThisWorkbook.Activate
Sheets("Spec").Range("F2:F" & entr).PasteSpecial Paste:=xlPasteValues

wb.Close

ThisWorkbook.Activate
Application.ScreenUpdating = 1
Application.EnableEvents = 1
Application.DisplayAlerts = 1
End Sub

Answer 1

要粘贴特殊值，xlValues或直接传输值并忽略隐藏的行，请处理.SpecialCells（xlCellTypeVisible）的Range.Areas property。

将此“ helper”子项放在公共模块中，以减少代码重复。

Sub transferVisibleValues(src As Range, des As Range)
    Dim a As Long, i As Long

    With src.SpecialCells(xlCellTypeVisible)
        For a = 1 To .Areas.Count
            With .Areas(a)
                des.Offset(i, 0).Resize(.Rows.Count, .Columns.Count) = .cells.Value
                i = i + .Rows.Count
            End With
        Next a
    End With
End Sub

现在您的代码变为

Sub SpecUpload()
    'lotsa stuff up here
    '...
    With wb.sht
        'trying copy and paste column 1
        debug.print .Range(.Cells(BomStart, V_col), .Cells(lr, V_col)).SpecialCells(xlCellTypeVisible).address(0, 0)
        transferVisibleValues .Range(.Cells(BomStart, V_col), .Cells(lr, V_col)), _
                              ThisWorkbook.Worksheets("Spec").Range("B2")

        'trying copy and paste column 2
        debug.print .Range(.Cells(BomStart, N_col), .Cells(lr, N_col)).SpecialCells(xlCellTypeVisible).address(0, 0)
        transferVisibleValues .Range(.Cells(BomStart, N_col), .Cells(lr, N_col)), _
                              ThisWorkbook.Worksheets("Spec").Range("D2")

        'trying copy and paste column 3
        debug.print .Range(.Cells(BomStart, Q_col), .Cells(lr, Q_col)).SpecialCells(xlCellTypeVisible).address(0, 0)
        transferVisibleValues .Range(.Cells(BomStart, Q_col), .Cells(lr, Q_col)), _
                              ThisWorkbook.Worksheets("Spec").Range("F2")
    End With

    '...
    'more stuff down here

End Sub

VBA：仅将可见行作为值复制到另一个工作簿

1 个答案: