Ошибки последней строки VBA - PullRequest
0 голосов
/ 10 июля 2020

Я использую этот код, но столбцы с последней строкой (A, B, K, L) заполняются 0 за пределами определенной последней строки. Кроме того, моя транзакция и тип иногда перестают работать, но если кто-нибудь увидит, что я делаю не так, я хотел бы узнать, чтобы у меня больше не было этой проблемы.

 Sub test()
Dim lastRow As Long
    

    lastRow = Cells(Rows.Count, 10).End(xlUp).Row

    'delete blank columns
    Range("W:W,U:U,S:S,Q:Q,O:O,M:M,K:K,I:I,G:G,E:E,C:C,A:A").Select
    Range("A1").Activate
    Selection.Delete Shift:=xlToLeft

      'filter for blanks
    Range("A:L").CurrentRegion.Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$L$1").AutoFilter Field:=10, Criteria1:="="
    ActiveSheet.AutoFilter.Range.Offset(1, 0).Rows.SpecialCells(xlCellTypeVisible).Delete (xlShiftUp)
      Selection.AutoFilter
 'Trans
    Columns("A:A").Select
       Selection.NumberFormat = "General"
       Range("A2:A" & lastRow).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
       Columns("A:A").Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
  'Type 
 Columns("B:B").Select
       Selection.NumberFormat = "General"
     Range("B2:B" & lastRow).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
        Columns("B:B").Select
       Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False 
   'Debit
   Range("K2:K" & lastRow).Select
     'Range(Selection, Selection.End(xlDown)).Select
        Selection.Replace What:="", Replacement:="0", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
           ReplaceFormat:=False
    'credit
       Range("L2:L" & lastRow).Select
        'Range(Selection, Selection.End(xlDown)).Select
        Selection.Replace What:="", Replacement:="0", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
               
End Sub

1 Ответ

0 голосов
/ 10 июля 2020

Извините за мой Engli sh, поймите неправильно ?

Попробуйте использовать цикл вместо замены. Используйте Dim EmptCell as range один раз.

Dim EmptCell as range
For Each EmptCell in Range("youRange").Cells
If EmptCell.value = "" Then EmptCell.value = 0
Next EmptCell

И постарайтесь не использовать выделение. Работайте напрямую с диапазонами или используйте переменные, как вы делали с LastRow.

Небольшой пример ниже.

 '  Trans 
Columns("A:A").NumberFormat = "General" 
Range("A2:A" & lastRow).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
 Columns("A:A").value = Columns("A:A").value   

И я определенно рекомендую изменить алгоритм LastRow на этот пуленепробиваемый. © { ссылка }

With Sheets("Sheet1")
    If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
        lastrow = .Cells.Find(What:="*", _
                      After:=.Range("A1"), _
                      Lookat:=xlPart, _
                      LookIn:=xlFormulas, _
                      SearchOrder:=xlByRows, _
                      SearchDirection:=xlPrevious, _
                      MatchCase:=False).Row
    Else
        lastrow = 1
    End If
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...