教えてください。
ユーザーフォームにリストボックス(Listbox1)があり、日付が昇順で入力されるようになっています。
ただし、この日付データは重複が多いため重複されないよう表示しようと下記のコードを記述しましたが「実行時エラー1004 アプリケーション定義またはオブジェクト定義のエラーです」と表示されてしまいます。
これを回避し、実行させるためにはどういう風に記述を修正したらよいでしょうか?
================================================================
Private Sub UserForm_Initialize()
Dim i As Long
For i = 2 To 2000
ListBox1.AddItem Worksheets("データ").Cells(i, 1)
Dim myValue As Variant
Dim myRng As Range, myCell As Range
Set myRng = Worksheets("データ").Cells(i, 1).End(xlUp)
myValue = myRng.Value
Application.ScreenUpdating = False
myRng.Sort Worksheets("データ").Cells(i, 1), xlAscending, Header:=xlYes
With ListBox1
.Clear
For Each myCell In myRng.Resize(myRng.Rows.Count - 1).Offset(1) _
.SpecialCells(xlCellTypeVisible)
.AddItem myCell.Value
Next
.ListIndex = 0
End With
Next i
ListBox1.ListIndex = 0
End Sub
================================================================
No.4ベストアンサー
- 回答日時:
> 抽出されたデータが重複しているものが3件あるはずなのに2件しか抽出
> されません。
すみません。寝ぼけてたみたいです。#3 もおかしなコードですね...
AddItem ではなく、 List の方が楽なので変更しましたが、これで大丈夫な
はずです。きっと(´・ω・`)
Private Sub UserForm_Initialize()
Dim i As Long
Dim lngR As Long
Dim myRng As Range
Dim Buffer As Variant
With Worksheets("データ")
lngR = .Cells(65536, "A").End(xlUp).Row
Set myRng = Range(.Cells(1, "A"), .Cells(lngR, "A"))
myRng.Sort Key1:=myRng(1, 1), Order1:=xlAscending, Header:=xlYes
.Range("B:B").ClearContents
myRng.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=.Range("B1"), _
Unique:=True
lngR = .Cells(65536, "B").End(xlUp).Row
Buffer = Range(.Cells(2, "B"), .Cells(lngR, "B")).Value
End With
With ListBox1
.Clear
.List = Buffer
.ListIndex = 0
End With
End Sub
No.3
- 回答日時:
すみません。
#1 のコードはところどころで必要なピリオド抜けが多いので、バグフィックスしたものを再掲しておきます。スペース節約のため、コメント
はカットしてます。
# No.2 のコメントにも一部誤記があります。
# ×降順ソート --> ○昇順ソート
Private Sub UserForm_Initialize()
Dim i As Long
Dim lngR As Long
Dim myRng As Range
With Worksheets("データ")
lngR = .Cells(65536, "A").End(xlUp).Row
Set myRng = Range(.Cells(1, "A"), .Cells(lngR, "A"))
myRng.Sort Key1:=myRng(1, 1), Order1:=xlAscending, Header:=xlYes
.Range("B:B").ClearContents
myRng.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=.Range("B1"), _
Unique:=True
lngR = .Cells(65536, "B").End(xlUp).Row
Set myRng = Range(.Cells(2, "B"), .Cells(lngR, "B"))
End With
With ListBox1
.Clear
For i = 2 To lngR - 1
.AddItem myRng.Cells(i, 1).Value
Next i
End With
ListBox1.ListIndex = 0
End Sub
この回答への補足
解答ありがとうございます。
参考にさせていただいたのですが、抽出されたデータが重複しているものが3件あるはずなのに2件しか抽出されません。
これはどの部分を修正したらよいでしょうか?
No.2
- 回答日時:
AddItem だとちょっと「もたつく」感じがします。
配列にして List プロパティーで一気に放り込んだ方が高速です。
Range を一次元配列にする方法、配列から重複値をドロップする方法なども
あわせて書いてみました。少々難易度はあがりますが、ご参考下さい。
Private Sub UserForm_Initialize()
' イベントプロシージャ内にはあまり長いコードは書かないで
' サブプロシージャを呼び出すようにするとコードがスッキリ
' します
Call SetListbox
End Sub
' リストボックスデータセット
Private Sub SetListbox()
Dim i As Long
Dim rngDataTbl As Range
Dim lngR As Long
Dim Buffer As Variant
On Error GoTo ERROR_HANDLER
With ThisWorkbook.Worksheets("データ")
' データの最終行を求め、データ範囲を rngDataTbl に参照
lngR = .Cells(65536, "A").End(xlUp).Row
Set rngDataTbl = Range(.Cells(1, "A"), .Cells(lngR, "A"))
End With
' 見出し付きで降順ソート
rngDataTbl.Sort Key1:=rngDataTbl(1, 1), Order1:=xlAscending, Header:=xlYes
' 見出しは不要なので、データ範囲を補正
Set rngDataTbl = rngDataTbl.Offset(1).Resize(rngDataTbl.Rows.Count - 1)
' データ範囲を一次元配列に変換
Buffer = Application.Transpose(rngDataTbl.Value)
' 配列から重複データをドロップする
Call GetUniqueArray(Buffer)
' リストボックスにデータセット
With ListBox1
.List = Buffer
.ListIndex = 0
End With
Set rngDataTbl = Nothing
Exit Sub
ERROR_HANDLER:
MsgBox "ListBox にデータを追加できません.", vbExclamation
End Sub
' 重複のない配列を生成(サブプロシージャ)
Private Sub GetUniqueArray(ByRef Source As Variant)
Dim colTmp As Collection
Dim aryTmp As Variant
Dim vntElm As Variant
Dim i As Long
On Error GoTo ERROR_HANDLER
Set colTmp = New Collection
' Collection には同一値を Add できない --> On Error Resume Next
' にすると、結果として重複値はカットされる
On Error Resume Next
For Each vntElm In Source
If vntElm <> Empty Then
colTmp.Add CStr(vntElm), CStr(vntElm)
End If
Next vntElm
On Error GoTo 0
If colTmp.Count = 0 Then
Exit Sub
Else
' Collection から配列に戻す
ReDim aryTmp(colTmp.Count - 1)
For i = 1 To colTmp.Count
' 書式化しておく
aryTmp(i - 1) = Format$(CDate(colTmp.Item(i)), "yyyy/mm/dd")
Next i
Source = aryTmp
End If
Set colTmp = Nothing
Exit Sub
ERROR_HANDLER:
Err.Raise 1000, , "重複のない配列の生成に失敗しました."
End Sub
No.1
- 回答日時:
こんにちは。
KenKen_SP です。もとのコードを最大限に活用すればこんな感じ。AdvancedFilter で重複値を
カットするため、作業用に B列 を使いました。
Private Sub UserForm_Initialize()
Dim i As Long
Dim lngR As Long
Dim myRng As Range
With Worksheets("データ")
lngR = .Cells(65536, "A").End(xlUp).Row
Set myRng = Range(.Cells(1, "A"), Cells(lngR, "A"))
' 見出し付きでソート
myRng.Sort Key1:=myRng(1, 1), Order1:=xlAscending, Header:=xlYes
' 重複のない日付をB列に転記
.Range("B:B").ClearContents
myRng.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Range("B1"), _
Unique:=True
' データ範囲をB列に訂正
lngR = .Cells(65536, "B").End(xlUp).Row
Set myRng = Range(.Cells(2, "B"), Cells(lngR, "B"))
End With
With ListBox1
.Clear
For i = 2 To lngR - 1
.AddItem myRng.Cells(i, 1).Text
Next i
End With
ListBox1.ListIndex = 0
End Sub
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) ExcelVBAで、index、match関数を使用して、指定範囲に出力したい 3 2022/10/18 21:53
- Visual Basic(VBA) いつもお世話になっております、VBAで教えて頂きたいのですが 2 2022/05/05 22:20
- Visual Basic(VBA) ユーザーフォームに2つのコンボボックス銀行名「ConboBox1」支店名を「ConboBox2」とし 4 2022/08/03 17:34
- Visual Basic(VBA) vbaを早くしたい 5 2022/09/09 10:58
- Visual Basic(VBA) VBA処理追加 こちらでご教示頂いたのですが回答完了させてしまいましたのでこちらからまた質問させてく 2 2022/10/27 09:57
- Visual Basic(VBA) VBAで質問ですが、皆さんはどの様に導き出しているのでしょうか? 6 2022/05/03 21:53
- Visual Basic(VBA) VBA Userformで一部別シートに転記がしたいのですが 2 2023/05/24 13:08
- Visual Basic(VBA) 前回ご教授いただいたコードに覚えたてのループ処理で品名りんごAから順に20回for nextでループ 7 2023/01/13 22:01
- Excel(エクセル) VBAの指示の内容 昨日こちらでご教示頂いたのですが初心者な為、一つ一つの指示が何をやっているのかわ 2 2022/10/25 18:08
- Visual Basic(VBA) ユーザーフォーム「frm_基本❶」を立ち上げると新規で入力する行数を右下のNoとして表示しています。 1 2023/03/16 19:02
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
合計3TBのデータのハッシュ値を...
-
教えて下さい
-
配列でデータが入っている要素...
-
【エクセル】測定時間がバラバ...
-
Accessで該当データにフラグを...
-
多量のSUMIF式を軽くしたい
-
[C言語] コメント文字列を無視...
-
メモ帳(テキストデータ)をExc...
-
Excelのマクロでワードのテキス...
-
C言語プログラム変更
-
配列の勉強をしています。使用...
-
ノイズの入った波形をきれいな...
-
VBAを使ってOutlookメール本文...
-
モジュラス103の算出方法について
-
ビットシフトについて
-
win7でvbsファイルが実行できない
-
EXCELVBAでSQLserverからデータ...
-
HTMLでテキストボックスで...
-
CString型の文字列連結について
-
GETはできるがPOSTができない、...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
教えて下さい
-
配列でデータが入っている要素...
-
【エクセル】測定時間がバラバ...
-
メモ帳(テキストデータ)をExc...
-
VBA 空白セルを削除ではない方...
-
多量のSUMIF式を軽くしたい
-
Excelのマクロでワードのテキス...
-
エクセルで2つの時系列のデー...
-
この行は既に別のテーブルに属...
-
VBAを使ってOutlookメール本文...
-
シーケンサにパソコンからアク...
-
EXCELVBAでSQLserverからデータ...
-
ブレーカー落ちで壊れたりしな...
-
[C言語] コメント文字列を無視...
-
オープンチヤットでデータ削除...
-
モジュラス103の算出方法について
-
javaでDBからデータを取ってき...
-
カンマからスラッシュに
-
VBA 毎日取得するデータを順番...
-
Android携帯をUSBメモリ代わりに
おすすめ情報