C16からC4565に書かれている文字を重複をしないリストにして、別ページのA1の位置へコピーする方

締切済

質問者：さあや14
質問日時：2017/12/26 12:18
回答数：4件

C16からC4565に書かれている文字を重複をしないリストにして、別ページのA1の位置へコピーする方法を教えてほしいです。

通報する

この質問への回答は締め切られました。

質問の本文を隠す

回答 (4件)

最新から表示
回答順に表示

No.5

回答者： mike32
回答日時：2017/12/31 13:37

No.4さんのマクロを実行して「オブジェクトが必要です」と出てしまうのは、

Sheet1以外を表示した状態でマクロを実行した場合だと思います。

Sheet1を表示した状態でやってみてください。

- 0
- 件

通報する

No.4

回答者： WindFaller
回答日時：2017/12/27 18:20

#1さんの回答と重複しますが、それをコードにすると、こんな感じかな？

Sub RemovalDoubled()
'C16からC4565に書かれている文字を重複をしないリスト
Dim Rng As Range
　Set Rng = ActiveSheet.Range("C16:C4565")
　With Worksheets("Sheet2")
　　Rng.Copy .Range("A1")
　　.Range("A1", .Cells(Rows.Count, 1).End(xlUp)).RemoveDuplicates _
　　　　Columns:=1, Header:=xlNo
　End With
End Sub

- 0
- 件

通報する

この回答へのお礼

オブジェクトが必要ですってでてしまいます！ちょっと考えみますね！

通報する

お礼日時：2017/12/28 10:10

参考程度に

No.2

回答者： tom04
回答日時：2017/12/26 18:12

こんばんは！

ExcelのVBAで良いのでしょうか？
元データはSheet1にあり、Sheet2のA列に表示するとします。
標準モジュールにしてください。

Sub Sample1()
Dim cnt As Long, c As Range, r As Range, wS As Worksheet
Set wS = Worksheets("Sheet2")
wS.Range("A:A").ClearContents
With Worksheets("Sheet1")
For Each c In .Range("C16:C4565")
Set r = wS.Range("A:A").Find(what:=c, LookIn:=xlValues, lookat:=xlWhole)
If r Is Nothing Then
cnt = cnt + 1
wS.Cells(cnt, "A") = c
End If
Next c
End With
wS.Activate
MsgBox "完了"
End Sub

※　上記コードはそこそこ時間を要すると思います。
↓のコードは時間短縮版になります。

Sub Sample2()
Dim myDic As Object
Dim i As Long, wS As Worksheet
Dim myKey, myR

Set myDic = CreateObject("Scripting.Dictionary")
Set wS = Worksheets("Sheet2")
wS.Range("A:A").ClearContents
With Worksheets("Sheet1")
myR = Range(.Cells(16, "C"), .Cells(4565, "C"))
For i = 1 To UBound(myR, 1)
If Not myDic.exists(myR(i, 1)) Then
myDic.Add myR(i, 1), ""
End If
Next i
End With
myKey = myDic.keys
myR = Range(wS.Cells(1, "A"), wS.Cells(UBound(myKey) + 1, "A"))
For i = 0 To UBound(myKey)
myR(i + 1, 1) = myKey(i)
Next i
Range(wS.Cells(1, "A"), wS.Cells(UBound(myKey) + 1, "A")) = myR
Set myDic = Nothing
wS.Activate
MsgBox "完了"
End Sub

※　両コードとも途中に空白セルはない！という前提のコードです。m(_ _)m