Excel - 提取“零”数据 - 小修改

Question

我想对 [上一个问题]添加一些小修改。

如何向代码主体添加条件以跳过具有彩色背景的“零”单元格？

检查单元格时，修改应忽略那些有任何背景颜色（标记为红色）的单元格，而只考虑那些没有背景格式（标记为蓝色）的单元格。

示例：

我的代码现在看起来像这样：

Option Explicit

Sub OB_Raport_brakow()
Dim i As Long, j As Long
Dim arrData As Variant
Dim rngData As Range
Dim arrRes, iR As Long
Dim LastRow As Long, wsOB As Worksheet
Dim DataRange As Range

' Sprawdza jaka jest ostatnia linia tabeli przestawnej
LastRow = ActiveSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

Set wsOB = Sheets("OB")

' Określa zakres komorek do sprawdzenia
' zakres półautomatyczny - początek na sztywno, a koniec na ostatni rząd tabeli przestawnej +1
' by ostatnie "zero" nie uciekało z raportu

' Set rngData = wsOB.Range("B4:R" & LastRow + 1)


    ' Deklaruj zmienną do przechowywania wyboru użytkownika
    Dim strCol As String
    

    ' Pyta jaka kolumna będzie ogranicznikiem do sprawdzania braków
    
    strCol = InputBox("Podaj kolumnę, do której mają zostać pobrane dane:", "Wybór kolumny")

    ' Ustaw rngData na zakres danych
    Set rngData = wsOB.Range("B4:" & strCol & LastRow + 1)


arrData = rngData.Value
ReDim arrRes(1 To UBound(arrData) * 31, 0)
iR = 0

For j = LBound(arrData, 2) + 2 To UBound(arrData, 2)
    If arrData(4, j) = "T" Then
        For i = LBound(arrData) + 4 To UBound(arrData)
            If arrData(i, j) = 0 And Not IsEmpty(arrData(i, j)) Then
                iR = iR + 1
                arrRes(iR, 0) = arrData(i, 2) & "-" & arrData(i, 1) & "-" & Format(arrData(2, j), "dd.mm.yyyy")
                
            End If
        Next
    End If
Next

On Error GoTo Catch
Try:
'Próbuje wybrać arkusz o wskaznej nazwie
    Sheets("OB Rp").Select
    GoTo Finally
Catch:
'Jeśli focus na wskazany arkusz się nie uda to tworzy go
    Sheets.Add(After:=Sheets("OB")).Name = "OB Rp"
Finally:
On Error GoTo 0

'Aktywuje arkusz do raportu, czyści go a następnie uzupełnia danymi
Sheets("OB Rp").Activate
'Cells.Clear
Range("B1:D600").ClearContents
Range("B1:B" & iR).Value = arrRes

'Rodziela na kolumny B i C, to co znajduje się w kolumnie A za pomocą separatora "-"
'Dim arrTmp() As String
'For i = 1 To iR
'    arrTmp = Split(arrRes(i, 0), "-")
'    Range("A" & i).Value = arrTmp(0)
'    Range("B" & i).Value = arrTmp(1)
'    Range("C" & i).Value = arrTmp(2)
'Next

'Na koniec sortuje A-Z według kolumny z nazwiskiem
Range("B1").Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlYes

End Sub

Answer 1

• 添加

  If

  子句以验证单元格上的填充格式

• rngData

  从

  B4

  开始，所以有行列偏移来获取单元格引用。

If arrData(i, j) = 0 And Not IsEmpty(arrData(i, j)) Then
    If wsOB.Cells(i + 3, j + 1).Interior.Color = xlNone Then
        iR = iR + 1
        arrRes(iR, 0) = arrData(i, 2) & "-" & arrData(i, 1) & "-" & Format(arrData(2, j), "dd.mm.yyyy")
    End If
End If