Excel VBA質問箱 IV

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

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


17499 / 76732 ←次へ | 前へ→

【64686】Re:指定する複数の値を抜き出したいのですが
発言  Yuki  - 10/3/8(月) 10:09 -

引用なし
パスワード
   ▼はるまき さん:
> fd = "0123"   ' 検索値
> は複数入力することはできますか?

Sub TEST()
  Dim i  As Long
  Dim j  As Long
  Dim k  As Long
  Dim v1 As Variant
  Dim s1 As String
  Dim s2 As String
  Dim fd As Variant
  Dim sht As Worksheet
  
  fd = Array("000", "1234", "012", "013")
  ' 新しいシートの追加1番前へ
  Set sht = Worksheets.Add(Before:=Worksheets(1))
  ' 手動で追加してある場合は
'  Set sht = Worksheets(1)
'  sht.Cells.ClearContents
  sht.Columns("A:B").NumberFormatLocal = "@"
  ' 2番目のシートから検索
  For i = 2 To Worksheets.Count
    With Worksheets(i)
      v1 = .Range("A1").CurrentRegion.Resize(, 1).Value
      v1 = Application.Transpose(v1)
      s1 = Join(v1, "")
      For k = 0 To UBound(fd)
        If Len(fd(k)) <= Len(s1) Then s2 = Left(s1, Len(fd(k)))
        If StrComp(fd(k), s2, vbTextCompare) = 0 Then
          ' あったら新しいシートに
          j = j + 1
          sht.Cells(j, 1) = .Name
          sht.Cells(j, 2) = s2
          Exit For '123,1234と言うような検索値が無い場合は
        End If
      Next
    End With
  Next
End Sub
0 hits

【64668】指定する複数の値を抜き出したいのですが はるまき 10/3/3(水) 19:33 質問
【64669】Re:指定する複数の値を抜き出したいのですが Yuki 10/3/4(木) 7:39 発言
【64670】Re:指定する複数の値を抜き出したいのですが はるまき 10/3/4(木) 17:42 質問
【64673】Re:指定する複数の値を抜き出したいのですが Yuki 10/3/5(金) 7:08 発言
【64681】Re:指定する複数の値を抜き出したいのですが はるまき 10/3/7(日) 20:37 質問
【64686】Re:指定する複数の値を抜き出したいのですが Yuki 10/3/8(月) 10:09 発言
【64702】Re:指定する複数の値を抜き出したいのですが はるまき 10/3/9(火) 12:29 お礼

17499 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free