Ben SuperUser üzerinde değil StackOverflow üzerinde olduğunu biliyorum, ama bu sorunun çözümü Excel 2016'da VBA kodu kullanarak bulunabilir.
Benzer (daha karmaşık) bir sorunum var.
Açık sütunlara bazı filtreler eklemek istiyorum, ancak aşağıdaki ekranın yakalanmasında görebileceğiniz gibi yalnızca satır 2'de satır 1'e değil.
Excel GUI kullanarak denedim ama bu imkansız görünüyor, bu yüzden aşağıdaki kodu yazdım:
'********************************************************
'* SetFilter()
'********************************************************
'* PUBLIC method to call to define CUSTOM AutoFilter
'* on complex header.
'********************************************************
Sub SetFilter()
'Compute last row number
Dim nLast As Long
nLast = Range("A" & Rows.Count).End(xlUp).Row
'Lock screen update
Application.ScreenUpdating = False
'Unmerge merged cells to allow adding filter
Range("A1:A2").MergeCells = False
Range("B1:B2").MergeCells = False
Range("C1:C2").MergeCells = False
Range("D1:D2").MergeCells = False
Range("E1:E2").MergeCells = False
Range("F1:F2").MergeCells = False
'Add filter on row 2 and not 1
Range("A2:Z" & nLast).Select
Selection.AutoFilter
'Remove (or Hide) filter combobox for some columns
Selection.AutoFilter Field:=GetColumnIndex("C"), VisibleDropDown:=False
Selection.AutoFilter Field:=GetColumnIndex("G"), VisibleDropDown:=False
Selection.AutoFilter Field:=GetColumnIndex("H"), VisibleDropDown:=False
'Merge unmerged cells to restore previous state
Range("A1:A2").MergeCells = True
Range("B1:B2").MergeCells = True
Range("C1:C2").MergeCells = True
Range("D1:D2").MergeCells = True
Range("E1:E2").MergeCells = True
Range("F1:F2").MergeCells = True
'Unlock screen update
Application.ScreenUpdating = True
End Sub
'********************************************************
'* GetColumnIndex()
'********************************************************
'* return column's index from column letters
'********************************************************
Function GetColumnIndex(sColLetter As String) As Integer
Dim n As Integer: n = 0
Dim iMax As Integer: iMax = Len(sColLetter)
Dim i As Integer
Dim sChar As String
Dim c As Integer
For i = 1 To iMax
sChar = Mid(sColLetter, i, 1)
c = 1 + Asc(sChar) - Asc("A")
n = n * 26 + c
Next
If n = 1 Then
n = 1
End If
GetColumnIndex = n
End Function
Bu kodun mantığı
Satır 2'de filtre eklemeye izin vermek için dikey olarak birleştirilmiş başlık hücrelerini ayırın
Range("A1:A2").MergeCells = False
A1 ve A2 hücreleri birleştirilmez.
B. satır 2'deki tüm hücrelere Otomatik Filtre ekleyin
Range("A2:Z" & nLast).AutoFilter
Otomatik Filtre, satır 1 dışındaki tüm satırlardaki hücreler için oluşturulur.
Bazı sütunlar için FILTER Combobox'ı kaldırın veya gizleyin
Selection.AutoFilter Field:=GetColumnIndex("C"), VisibleDropDown:=False
"C" Sütununun DropBox gizlidir.
D. Orijinal durumu geri yüklemek için birleştirilmemiş hücreleri birleştir
Range("A1:A2").MergeCells = True
A1 ve A2 hücreleri tekrar birleştirilir.