Question

我正在尝试解析许多不同的表并挑选出具体的数据。然后，我需要将此数据放入特定的列和行，这些列和行取决于它们在原始工作表中的列和行。为了确定行，我需要创建一个包含列的范围，一直到当前单元格。我找到了解释如何执行此操作的代码（Select from ActiveCell to first cell in column. Data in column includes blanks），但是当我运行它时，它会抛出错误消息＆＃34; Method＆＃34; Range＆＃34;对象＆＃34;工作表＆＃34;＆＃34;不支持。我已经尝试在Range语句之前删除xSheet。我的代码可能还有其他问题吗？非常感谢您的帮助！

Dim xSheet As Worksheet, DestSh As Worksheet
Dim Last As Long, crow As Long, ccol As Long
Dim copyRng As Range, destRng As Range, colSrc As Range, rowSrc As Range
Dim cRange As Range, copyTemp As Range, copyEnd As Range, copyStart As Range
Dim exchDest As Range, rowRange As Range
Dim numCol As Long, numRow As Long
Dim c As Range, q As Range
Dim uniqueVal() As Variant, x As Long

For Each xSheet In ActiveWorkbook.Worksheets
        'Edit 
        Set copyStart = xSheet.Range("A1")
        crow = xSheet.Cells(Rows.Count, 1).End(xlUp).Row
        ccol = xSheet.Cells(1, Columns.Count).End(xlToRight).Column 'find a smarter way of doing this
        Set copyEnd = xSheet.Cells(crow, ccol)
        Set copyRng = xSheet.Range(copyStart, copyEnd)    

    If InStr(1, xSheet.Name, "ACCOUNT") And xSheet.Range("B1") <> "No Summary Available" Then _

        For Each c In copyRng.SpecialCells(xlCellTypeVisible)

            If IsNumeric(c) And Not c.Value = "0" Then _

                Set rowRange = xSheet.Range(c.EntireColumn.Cells(1), c) 'problem line
                For Each q In rowRange.SpecialCells(xlCellTypeVisible)
                    If InStr(1, q.Value, "C-") Then _
                        Set rowSrc = q
                    Next q

                Set colSrc = c.EntireRow.Offset(0).Cells(1)
                numCol = DestSh.Cells.Find(colSrc.Value, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Column
                numRow = DestSh.Cells.Find(rowSrc.Value, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

                'Set destination
                Set destRng = DestSh.Cells(numRow, numCol)

                'Copy to destination Range
                c.Copy destRng



                'If destRng.Column > 40 Then _
                '   Set destRng = destRng.Offset(1, -30)


            End If

        Next c

    End If

Next xSheet

将工作表中的单元格与摘要表/ VBA

0 个答案: