返回列表 上一主題 發帖

清單

清單

各位前輩你們好!
       前輩!問題如附檔案說明
         請知道的前輩,不吝賜教謝謝再三!!

Leov1.rar (9.72 KB)

回復 1# myleoyes
    Sub 清單()  'Dictionary 物件
    Dim D As Object
    Set D = CreateObject("SCRIPTING.DICTIONARY")
    With Sheet1
        For Each E In .Range("C2", .Range("C2").End(xlToRight))
            D(E.Value) = ""
        Next
        .[A3].Resize(D.Count, 1) = Application.Transpose(D.KEYS)
    End With
End Sub
Sub 清單() 'Array
    Dim Ar()
    ReDim Preserve Ar(0)
    With Sheet1
        Ar(0) = .[C2]
        For Each E In .Range("D2", .Range("D2").End(xlToRight))
            If UBound(Filter(Ar, E, True)) = -1 Then
                ReDim Preserve Ar(UBound(Ar) + 1)
                Ar(UBound(Ar)) = E
            End If
        Next
        .[A3].Resize(UBound(Ar) + 1, 1) = Application.Transpose(Ar)
    End With
End Sub

TOP

老夏前輩你好!
    前輩謝謝!!歹勢啦!!小弟對於樞紐分析表
     實在不懂更不知要如何著手....?
    以後會慢慢學習
     前輩不吝賜教謝謝再三!!

TOP

GBKEE前輩你好!
  恭喜!!良師晉升版主當之無愧!!歹勢啦!小弟最近較忙
         又把檔案弄錯..範例應該如下Leov1-2.xls
       不過你的程式是對的只是碰到跨欄至中
         會凸槌附檔請再辛苦囉!謝謝再三!!

Leov1-2.rar (10.87 KB)

TOP

回復 6# myleoyes
Sub 清單()  'Dictionary 物件
    Dim D As Object
    Set D = CreateObject("SCRIPTING.DICTIONARY")
    With Sheet1
        For Each E In .Range("C2", .Range("IV2").End(xlToLeft))
            If E <> "" Then D(E.Value) = ""
        Next
        .[A3].Resize(D.Count, 1) = Application.Transpose(D.KEYS)
    End With
End Sub
Sub 清單S() 'Array
    Dim Ar()
    ReDim Preserve Ar(0)
    With Sheet1
        Ar(0) = .[C2]
        For Each E In .Range("D2", .Range("IV2").End(xlToLeft))
            If E <> "" Then
                If UBound(Filter(Ar, E, True)) = -1 Then
                    ReDim Preserve Ar(UBound(Ar) + 1)
                    Ar(UBound(Ar)) = E
                End If
            End If
        Next
        .[A3].Resize(UBound(Ar) + 1, 1) = Application.Transpose(Ar)
    End With
End Sub

TOP

GBKEE前輩你好!
   良師!太棒囉!!謝謝再三!!

TOP

GBKEE前輩你好!
     良師!!救命啊!!為何如此...!!
              無法正確比對附檔請再辛苦囉!謝謝再三!!

Leov1-31.rar (15.93 KB)

Leov1-32.rar (18.98 KB)

TOP

回復 9# myleoyes
這個範例點選A3或A4或A10或A11,再按B2比對皆無法比對       
但選擇其他儲存格就正常       
請按A2清單恢復原狀請重複測試       
請再清楚說明你要的是什麼 比對什麼

TOP

GBKEE前輩你好!
     良師!!問題如附檔案說明
                  請再辛苦囉!謝謝再三!!

Leov1-33.rar (96.55 KB)

TOP

本帖最後由 Hsieh 於 2010-5-28 23:23 編輯

修改這行
Set C = Columns("B").Find(Trim(b), lookat:=xlWhole)

Set C = Columns("B").Find(b, lookat:=xlWhole)
學海無涯_不恥下問

TOP

        靜思自在 : 【時間如鑽石】時間對一個有智慧的人而言,就如鑽石般珍貴;但對愚人來說,卻像是一把泥土,一點價值也沒有。
返回列表 上一主題