帖子: 561
主題: 160
精華: 0
積分: 725
點名: 0
作業系統: WINDOWS
軟體版本: xp
閱讀權限: 50
性別: 男
來自: 桃園
註冊時間: 2014-9-10
最後登錄: 2024-8-7

論壇榮譽勳章論壇贊助勳章熱烈參與勳章

1^# 跳轉到 » 倒序看帖

字體大小: tT

發表於 2017-9-6 16:36 | 只看該作者

[發問] 資料庫取不重覆資料方式請教

DEAR ALL 大大-
1.如圖一資料庫於SHEET1中
2.原則: 要抓取SHEET1不重覆資料至SHEET2中
2.1 前6碼相同算重覆.抓取不重覆資料至SHEET2中.結果如圖二
3.請教如何下 VBA 語法??煩不吝賜教 THANKS*10000
圖一資料庫
SHEET1
A1=編號       B1=項目
A2=A12345A    B2=1
A3=B12345B    B3=2
A4=B12345*    B4=3
A5=A12345    B5=4
A6=B12345    B6=5
圖二結果
SHEET2
A1=編號       B1=項目
A2=A12345       B2=4
A3=B12345       B3=5

樓主熱帖

羅

ML089

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2025
主題: 13
精華: 0
積分: 2053
點名: 0
作業系統: WIN7
軟體版本: Office2007
閱讀權限: 100
性別: 男
來自: 台北市
註冊時間: 2011-3-2
最後登錄: 2024-3-14

論壇榮譽勳章論壇贊助勳章熱烈參與勳章 2014馬年全勤獎章 2015羊年全勤獎章 2016猴年全勤獎章

2^#

發表於 2017-9-6 21:35 | 只看該作者

Sub ex1()
Arr = Sheet1.Range("A1").CurrentRegion
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Arr)
d(Left(Arr(i, 1), 6)) = Arr(i, 2)
Next
Sheet2.[A1:B65536].ClearContents
Sheet2.[A1].Resize(d.Count, 2) = Application.Transpose(Array(d.keys, d.items))
End Sub

{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

TOP

rouber590324

高中生 Rank: 3 Rank: 3

帖子: 561
主題: 160
精華: 0
積分: 725
點名: 0
作業系統: WINDOWS
軟體版本: xp
閱讀權限: 50
性別: 男
來自: 桃園
註冊時間: 2014-9-10
最後登錄: 2024-8-7

論壇榮譽勳章論壇贊助勳章熱烈參與勳章

3^#

發表於 2017-9-7 08:36 | 只看該作者

DEAR ML089 大大
100%符合需求.THANKS*10000

羅

TOP

rouber590324

高中生 Rank: 3 Rank: 3

帖子: 561
主題: 160
精華: 0
積分: 725
點名: 0
作業系統: WINDOWS
軟體版本: xp
閱讀權限: 50
性別: 男
來自: 桃園
註冊時間: 2014-9-10
最後登錄: 2024-8-7

論壇榮譽勳章論壇贊助勳章熱烈參與勳章

4^#

發表於 2017-9-7 08:42 | 只看該作者

DEAR 大大
  如下.原A.B欄資料轉換要改為 A-F欄資料轉換
  為何 Sheet2.[A1].Resize(d.Count, 2) 改 Sheet2.[A1].Resize(d.Count, 6)
後 C.D.E.F欄資料都出現 N/A 煩不吝賜教  THANKS

Sub AA()
Arr = Sheet1.Range("A1").CurrentRegion
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Arr)
      d(Left(Arr(i, 1), 6)) = Arr(i, 2)
Next
Sheet2.[A1:F65536].ClearContents
Sheet2.[A1].Resize(d.Count, 6) = Application.Transpose(Array(d.keys, d.items))
End Sub

羅

TOP

ML089

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2025
主題: 13
精華: 0
積分: 2053
點名: 0
作業系統: WIN7
軟體版本: Office2007
閱讀權限: 100
性別: 男
來自: 台北市
註冊時間: 2011-3-2
最後登錄: 2024-3-14

論壇榮譽勳章論壇贊助勳章熱烈參與勳章 2014馬年全勤獎章 2015羊年全勤獎章 2016猴年全勤獎章

5^#

發表於 2017-9-7 16:01 | 只看該作者

回復 4# rouber590324
要詢問，請於問題下方按回覆鍵

取A-F欄資料
Sub ex2()
Arr = Sheet1.Range("A1").CurrentRegion
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Arr)
d(Left(Arr(i, 1), 6)) = Array(Arr(i, 1), Arr(i, 2), Arr(i, 3), Arr(i, 4), Arr(i, 5), Arr(i, 6))
Next
Sheet2.[A1:F65536].ClearContents
Sheet2.[A1].Resize(d.Count, 6) = Application.Transpose(Application.Transpose(d.items))
End Sub

{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

TOP

hcm19522