12
返回列表 上一主題 發帖

[發問] [已解決]如何地址分類

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
250  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-11-18 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
3# 跳轉到 »
發表於 2012-2-7 00:54 | 只看該作者
本帖最後由 Hsieh 於 2012-2-7 01:23 編輯

回復 2# owen9399
可製作一個分類表
再以分類表為標準來分類如圖
  1. Sub nn()
  2. Dim Ar(2), Ay()
  3. Set d = CreateObject("Scripting.Dictionary")
  4. With Sheets("Sheet1")
  5. Ar(0) = Array(.[A1].Value, .[B1].Value, .[C1].Value, .[D1].Value, .[E1].Value)
  6. For Each a In .Range("E2", .[E65536].End(xlUp))
  7. i = IIf(InStr(a, "縣") > 0, 4, 1)
  8.    mystr = Mid(a, i, 3)
  9.    Set B = .Columns("I:K").Find(mystr, lookat:=xlWhole)
  10.    If B Is Nothing Then
  11.       ky = 5
  12.    Else
  13.       ky = .Cells(B.Row, "H").Value
  14.    End If
  15.    If IsEmpty(d(ky)) Then
  16.       Ar(1) = Array(a.Offset(, -4).Value, a.Offset(, -3).Value, a.Offset(, -2).Value, a.Offset(, -1).Value, a.Value)
  17.       d(ky) = Ar
  18.       Else
  19.       Ay = d(ky)
  20.       s = UBound(Ay)
  21.       ReDim Preserve Ay(s + 1)
  22.       Ay(s) = Array(a.Offset(, -4).Value, a.Offset(, -3).Value, a.Offset(, -2).Value, a.Offset(, -1).Value, a.Value)
  23.       d(ky) = Ay
  24.       Erase Ay
  25.     End If
  26. Next
  27. End With
  28. With Sheets("Sheet2")
  29. .[A:F] = ""
  30. r = 1
  31. For Each ky In d.keys
  32.    For i = LBound(d(ky)) To UBound(d(ky))
  33.       .Cells(r, "A").Resize(, 5) = d(ky)(i)
  34.       r = r + 1
  35.    Next
  36. Next
  37. End With
  38. End Sub
複製代碼
學海無涯_不恥下問

TOP

owen9399

帖子
94 
主題
16 
精華
0 
積分
128 
點名
0  
作業系統
XP 
軟體版本
OFFICE 2003 
閱讀權限
20 
性別
男 
註冊時間
2012-1-30 
最後登錄
2015-11-17 
2#
發表於 2012-2-7 00:08 | 只看該作者
我目前 有用  字串 來取代

但有一些問題
owen

TOP

        靜思自在 : 話多不如話少，話少不如話好。
12
返回列表 上一主題