Удалить дублирующийся динамический диапазон, сохраняя в первую очередь, используя разделение на основе определенной строки - PullRequest
Новая
       7

Удалить дублирующийся динамический диапазон, сохраняя в первую очередь, используя разделение на основе определенной строки

0 голосов
/ 24 апреля 2019

У меня есть несколько несколько уникальных данных (да, все данные уникальны), которые я пытаюсь проанализировать и удалить повторяющиеся диапазоны, но сохраняю первый уникальный диапазон. Я не вижу в любом случае сортировать данные, так как все это один столбец, но в разрезе. Пример данных ниже: 

SSID 18 : NewThermostat_552845
Network type            : Infrastructure
Authentication          : Open
Encryption              : None 
BSSID 1                 : 00:d0:2d:55:28:45
     Signal             : 78%  
     Radio type         : 802.11n
     Channel            : 6 
     Basic rates (Mbps) : 1 2 5.5 6 11 12 24
     Other rates (Mbps) : 9 18 36 48 54

SSID 24 : 
Network type            : Infrastructure
Authentication          : Open
Encryption              : None 
BSSID 1                 : f8:bb:bf:59:56:89
     Signal             : 35%  
     Radio type         : 802.11n
     Channel            : 1 
     Basic rates (Mbps) : 1 2 5.5 11
     Other rates (Mbps) : 6 9 12 18 24 36 48 54

SSID 11 : NewThermostat_552845
Network type            : Infrastructure
Authentication          : Open
Encryption              : None 
BSSID 1                 : 00:d0:2d:55:28:45
     Signal             : 94%  
     Radio type         : 802.11n
     Channel            : 6 
     Basic rates (Mbps) : 1 2 5.5 6 11 12 24
     Other rates (Mbps) : 9 18 36 48 54

SSID ## - начало каждого нового раздела. По моему коду ниже вы можете увидеть разные вещи, которые я пробовал Я прокомментировал вещи, которые не работали, но могли бы работать в другой комбинации. Я использовал MsgBox и copy / paste для отладки, так что в конечном коде это не требуется.

Вот код, с которым я работаю. 

'need to split the cell
dRow = newSht.Cells(Rows.Count, "A").End(xlUp).Row
Set dString = newSht.Range("A1:A" & dRow)
For Each cel In dString
    If cel.Value Like "SSID ## : *" Then
        'If cel.Value = cel.Value Then
        theSplit = Split(cel.Value, ":")(0)(1)
        'If theSplit(1) = theSplit(1) Then
        If theSplit(0) Like theSplit(-1) Then 'And cel.Value(0) = cel.Value(0) Then
            'cel.Value(1).Copy
            'Range("F1").PasteSpecial Paste:=xlPasteValues
            MsgBox cel.Value

            'Range(cel, cel.End(xlDown)).Delete
            'cel.Value(1).Copy Range("F1")
            'Range(cel, cel.End(xlDown)).Delete
        End If
    End If
    'End If
Next cel

Я думаю, что лучший способ - разделить каждый экземпляр SSID ## по знаку:. Затем, если совпадает любая из 2-х частей строки, удалите диапазон от SSID ## до пустой ячейки. В настоящее время мой код удаляет все! Заранее спасибо за понимание! Очень ценится!

1 Ответ

1 голос
/ 24 апреля 2019

Что-то вроде этого должно работать для вас: 

Sub tgr()

    Dim ws As Worksheet
    Dim rData As Range
    Dim rAllRegions As Range
    Dim rRegion As Range
    Dim rDel As Range
    Dim hSSID As Object
    Dim sSSID As String

    Set ws = ActiveWorkbook.ActiveSheet
    Set rData = ws.Range("A1", ws.Cells(ws.Rows.Count, "A").End(xlUp))
    Set rAllRegions = GetAllPopulatedCells(, rData)
    Set hSSID = CreateObject("Scripting.Dictionary")

    If rAllRegions Is Nothing Then
        MsgBox "No populated cells found in '" & ws.Name & "'. Exiting Macro.", , "Error"
        Exit Sub
    End If

    For Each rRegion In rAllRegions.Areas
        sSSID = LCase(Trim(Split(rRegion.Cells(1).Value, ":")(1)))
        If Not hSSID.exists(sSSID) Then
            hSSID.Add sSSID, sSSID
        Else
            If rDel Is Nothing Then Set rDel = rRegion.Resize(rRegion.Rows.Count + 1) Else Set rDel = Union(rDel, rRegion.Resize(rRegion.Rows.Count + 1))
        End If
    Next rRegion

    If Not rDel Is Nothing Then rDel.Delete xlShiftUp

End Sub

Public Function GetAllPopulatedCells(Optional ByRef arg_ws As Worksheet, Optional ByVal arg_rSearchRange As Range) As Range

    Dim ws As Worksheet
    Dim rSearch As Range
    Dim rConstants As Range
    Dim rFormulas As Range

    If arg_ws Is Nothing Then Set ws = ActiveWorkbook.ActiveSheet Else Set ws = arg_ws
    If arg_rSearchRange Is Nothing Then Set rSearch = ws.Cells Else Set rSearch = arg_rSearchRange

    On Error Resume Next
    Set rConstants = rSearch.SpecialCells(xlCellTypeConstants)
    Set rFormulas = rSearch.SpecialCells(xlCellTypeFormulas)
    On Error GoTo 0

    Select Case Abs(rConstants Is Nothing) + 2 * Abs(rFormulas Is Nothing)
        Case 0: Set GetAllPopulatedCells = Union(rConstants, rFormulas)
        Case 1: Set GetAllPopulatedCells = rFormulas
        Case 2: Set GetAllPopulatedCells = rConstants
        Case 3: Set GetAllPopulatedCells = Nothing
    End Select

    Set ws = Nothing
    Set rSearch = Nothing
    Set rConstants = Nothing
    Set rFormulas = Nothing

End Function

ОБНОВЛЕНИЕ : в этой версии будут храниться только блоки с наивысшей силой сигнала для каждого региона (обратите внимание, что вам все еще понадобится функция GetAllPopulatedCells) 

Sub tgr()

    Dim ws As Worksheet
    Dim rData As Range
    Dim rAllRegions As Range
    Dim rRegion As Range
    Dim rDel As Range
    Dim rTemp as Range
    Dim hSSID As Object
    Dim sSSID As String
    Dim lSSIDRow as Long
    Dim lSignalRow as Long

    Set ws = ActiveWorkbook.ActiveSheet
    Set rData = ws.Range("A1", ws.Cells(ws.Rows.Count, "A").End(xlUp))
    Set rAllRegions = GetAllPopulatedCells(, rData)
    Set hSSID = CreateObject("Scripting.Dictionary")
    lSSIDRow = 1
    lSignalRow = 6

    If rAllRegions Is Nothing Then
        MsgBox "No populated cells found in '" & ws.Name & "'. Exiting Macro.", , "Error"
        Exit Sub
    End If

    For Each rRegion In rAllRegions.Areas
        sSSID = LCase(Trim(Split(rRegion.Cells(lSSIDRow, 1).Value, ":")(1)))
        If Not hSSID.exists(sSSID) Then
            Set hSSID(sSSID) = rRegion
        Else
            If --Trim(Split(hSSID(sSSID).Cells(lSignalRow, 1).Value, ":")(1)) > --Trim(Split(rRegion.Cells(lSignalRow, 1).Value, ":")(1)) Then
                Set rTemp = rRegion.Resize(rRegion.Rows.Count + 1)
            Else
                Set rTemp = hSSID(sSSID)
                Set hSSID(sSSID) = rRegion
            End If
            If rDel Is Nothing Then Set rDel = rTemp Else Set rDel = Union(rDel, rTemp)
        End If
    Next rRegion

    If Not rDel Is Nothing Then rDel.Delete xlShiftUp

End Sub
...