Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

17516 / 76732

←次へ　｜　前へ→


	【64669】Re:指定する複数の値を抜き出したいのですが

Yuki - 10/3/4(木) 7:39 -


	引用なし

	パスワード

▼はるまきさん：
>例えば、下のようにＡ列に縦に並んだデータのシートが数十枚あります。
>
>その各シートのデータの先頭の値と、
>指定する値（複数あります）に当てはまったデータだけを新しいシートに抜き出す方法はありますでしょうか？
>
新しいシートを追加していますが実行する度に追加しますので
一番左 Worksheets(1) を最初から手動で追加してそれを参照すれば
宜しいかと思います

Option Explicit
Sub TEST()
　　Dim i　 As Long
　　Dim j　 As Long
　　Dim v1　As Variant
　　Dim s　 As String
　　Dim fd　As String
　　Dim sht As Worksheet
　　
　　fd = "0123"　　 ' 検索値

　　' 新しいシートの追加1番前へ毎回追加される
　　Set sht = Worksheets.Add(Before:=Worksheets(1))
　　　　' 手動で追加してある場合は
'　　Set sht = Worksheets(1)
'　　sht.Cells.ClearContents
　　' 2番目のシートから検索
　　For i = 2 To Worksheets.Count
　　　　With Worksheets(i)
　　　　　　v1 = .Range("A1").CurrentRegion.Resize(, 1).Value
　　　　　　v1 = Application.Transpose(v1)
　　　　　　s = Join(v1, "")
　　　　　　If Len(fd) <= Len(s) Then s = Left(s, Len(fd))
　　　　　　If StrComp(fd, s, vbTextCompare) = 0 Then
　　　　　　　　' あったら新しいシートに
　　　　　　　　j = j + 1
　　　　　　　　sht.Cells(j, 1) = .Name
　　　　　　　　sht.Cells(j, 2) = s
　　　　　　End If
　　　　End With
　　Next
End Sub

0 hits

▼

【64668】指定する複数の値を抜き出したいのですが はるまき 10/3/3(水) 19:33