簡體   English   中英

使用動態范圍替換空白單元格的VBA字無效限定詞錯誤

[英]VBA word Invalid Qualifier error using Dynamic Ranges to replace blank cells

我正在編寫一小段代碼,它將通過執行以下操作運行:

  1. 找到數據塊的最大大小(什么是最后一個包含數據的單元以及由LRow和LCol給出的坐標)
  2. 搜索列中的數據(希望使其成為列的范圍),如果單元格為空,則使用其上方的單元格的值。
  3. 創建一個新工作表並重命名
  4. 瀏覽數據,僅選擇在k列中具有“致命”一詞的那些行,然后將這些行粘貼到新的重命名工作表中。

下面是到目前為止的代碼。 誰能實現我上面提到的改進,並弄清楚為什么我使用LRow獲得無效的預選賽錯誤? 該代碼從Word文檔啟動,以打開excel電子表格並使用電子表格中的數據。

單擊按鈕激活全局子:

Private Sub ObtainFatalCrashInfoButton_Click()
'Disable screen updating
'Application.ScreenUpdating = False
Application.Run ("OpenRawDataFile")
Application.Run ("FixData")
Application.Run ("GetData")
'Application.Run ("CloseRawDataFile")
Application.Run ("CommandButtonRemove")
'Enable screen updating
'Application.ScreenUpdating = True

End Sub

然后依次激活以下子:

Sub OpenRawDataFile()
'Not sure this works....
Set appExcel = CreateObject("Excel.Application")

Dim IFAM_Index As Variant

Dim IFAM_File As Variant

IFAM_File = appExcel.GetOpenFilename("Excel files (*.xls), *.xls")

appExcel.Workbooks.Open IFAM_File

End Sub

子FixData。 添加丟失的數據以使過程的下一部分更容易

Sub FixData()
Dim i As Long
Dim LRow As Long, LCol As Long
Dim rngD As Range

'Set the range of the "Duration Working" Spreadsheet
LRow = wb.Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
LCol = wb.Worksheets("Sheet2").Cells(1, Columns.Count).End(xlToLeft).Column
Set rngD = Range(Cells(2, 1), Cells(LRow, LCol))


For i = 1 To LRow.Rows.Count
    If LRow.Cells(i, 11).Value = "" Then
        LRow.Cells(i, 11).Value = LRow.Cells(i - 1, 1).Value
    End If
Next
End Sub

子GetData()。 SUb應該將符合條件的行復制到新的工作表中,以使其更容易提取為所需格式的單詞(此部分尚未編寫)。

Sub GetData()

'Create new tab to copy data to
Dim WS As Worksheet

Set WS = Sheets.Add

'assuming the data is in sheet1
Sheets("Sheet2").Select
RowCount = LRow
For jj = 1 To RowCount
    'assuming the true statment is in column k
    Range("k" & jj).Select
    check_value = ActiveCell
    If check_value = "Fatal" Or check_value = "fatal" Then
        ActiveCell.EntireRow.Copy
        'assuming the data is in sheet2
        WS.Select
        RowCount = Cells(Cells.Rows.Count, "k").End(xlUp).Row
        Range("k" & RowCount + 1).Select
        ActiveSheet.Paste
        Sheets("Sheet2").Select
    End If
Next

End Sub

子CopyData()。 待寫。 將以特定格式將數據復制到單詞。 有任何建議嗎?

Sub CopyData()
'....To be written
End Sub

子CloseRawDataFile。 關閉原始數據文件而不保存,因為現在應該將數據復制為所需格式的word。

Sub CloseRawDataFile()

wb.Close SaveChanges:=False
Set wb = Nothing

End Sub

子CommandButton刪除。 從Word文檔中刪除命令按鈕,因為不再需要該過程。

Sub CommandButtonRemove()
Dim iShp As Word.InlineShape
For Each iShp In ActiveDocument.InlineShapes
If iShp.Type = wdInlineShapeOLEControlObject Then
    If iShp.OLEFormat.Object.Name = "ObtainFatalCrashInfoButton" Then
        iShp.Range.Font.Hidden = True
    End If
End If
Next
End Sub

最終,此代碼將搜索數據集並將符合條件的內容粘貼到預定義表中的word文檔中。 在我嘗試簡化代碼時,我嘗試將其分離出來。 因此,現階段只需要搜索代碼並將其粘貼到新表中。

其他方面尚待編寫的任何幫助也將是巨大的幫助!

我將其發布為FixData例程的潛在修補程序。 即使它實際上並沒有達到您的預期目的,也可能使您對要使其余代碼正常工作必須處理的事情有所了解。

'Force developer to declare every variable that is being used
Option Explicit

'Define module-level scoped variables, which will be available to all
'procedures in this code module
Private appExcel As Object
Private wb As Object
Private LRow As Long
'Need to define all the constants that are normally available in Excel VBA
Private Const xlUp As Long = -4162
Private Const xlToLeft As Long = -4159

Private Sub ObtainFatalCrashInfoButton_Click()
    OpenRawDataFile
    'Disable screen updating
    appExcel.ScreenUpdating = False
    FixData
    'Application.Run ("GetData")
    'Application.Run ("CloseRawDataFile")
    'Application.Run ("CommandButtonRemove")
    'Enable screen updating
    appExcel.ScreenUpdating = True
End Sub

Sub OpenRawDataFile()
    Set appExcel = CreateObject("Excel.Application")

    Dim IFAM_Index As Variant
    Dim IFAM_File As Variant

    IFAM_File = appExcel.GetOpenFilename("Excel files (*.xls), *.xls")

    'Create a workbook object that we can refer to
    Set wb = appExcel.Workbooks.Open(IFAM_File)
End Sub

Sub FixData()
    Dim i As Long
    'Your question implies that you need LRow to be module-level scope
    ' so remove declaration from here
    'Dim LRow As Long, LCol As Long
    Dim LCol As Long
    '"As Range" in Word means "As Word.Range".  If you are using
    ' late-binding to access Excel, you need to declare rngD "As Object"
    'Dim rngD As Range
    Dim rngD As Object

    'Set the range of the "Duration Working" Spreadsheet
    '"Rows" and "Columns" need to be qualified, because Word doesn't know that
    ' you really mean that to be "appExcel.ActiveWorkbook.ActiveSheet.Rows", etc,
    ' (and you probably didn't mean that anyway)
    'LRow = wb.Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
    'LCol = wb.Worksheets("Sheet2").Cells(1, Columns.Count).End(xlToLeft).Column
    LRow = wb.Worksheets("Sheet2").Cells(wb.Worksheets("Sheet2").Rows.Count, 1).End(xlUp).Row
    LCol = wb.Worksheets("Sheet2").Cells(1, wb.Worksheets("Sheet2").Columns.Count).End(xlToLeft).Column
    '"Range" and "Cells" need to be qualified, because Word doesn't know that
    ' you really mean that to be "appExcel.ActiveWorkbook.ActiveSheet.Range", etc,
    ' (and you probably didn't mean that anyway)
    'Set rngD = Range(Cells(2, 1), Cells(LRow, LCol))
    Set rngD = wb.Worksheets("Sheet2").Range(wb.Worksheets("Sheet2").Cells(2, 1), wb.Worksheets("Sheet2").Cells(LRow, LCol))

    'To save typing, the previous statements could be written as
    'With wb.Worksheets("Sheet2")
    '    LRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    '    LCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
    '    Set rngD = .Range(.Cells(2, 1), .Cells(LRow, LCol))
    'End With

    'This section was probably meant to work on "rngD"
    'For i = 1 To LRow.Rows.Count
    '    If LRow.Cells(i, 11).Value = "" Then
    '        LRow.Cells(i, 11).Value = LRow.Cells(i - 1, 1).Value
    '    End If
    'Next
    For i = 1 To rngD.Rows.Count
        If rngD.Cells(i, 11).Value = "" Then
            rngD.Cells(i, 11).Value = rngD.Cells(i - 1, 1).Value
        End If
    Next
End Sub

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM