Excel VBA質問箱 IV

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

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


70538 / 76733 ←次へ | 前へ→

【10700】Re:抽出したい
回答  Jaka  - 04/2/9(月) 9:49 -

引用なし
パスワード
   日付も検索対象に加えてみました。    
Sheet1、2の日付がどうやって記入されているのか解らないと手が出ませんけど...。    
Sheet1、日付の表示形式が、「m/d"日"」    
Sheet2、日付の表示形式が、「3月4日」    
と、なっているとして。    

テスト環境がシート3だったもので、変えてください。    
She3 → She2    
Sheets("Sheet3") → Sheets("Sheet2")
She3XX → She2XX

データが同じパターンで増えて幾分には、Sheet2では255列までなら大丈夫ですが、256列はダメです。
それと、日付は年号からしっかり2004/2/2と書くようにした方が、後々の為に良いと思います。
関数で表示された日付は、マクロのFind検索でまともに引っかからないから...。
手動なら大体引っかかるみたいですが、マクロだと、いちいち日付の入っているセルを探して、表示形式まで調べてって事になりそうなんで...。
Match使えばいいじゃんと思えますが、一列または1行ずつしか調べられないし、ループ組むのにも面倒だし...。
日付と名前のどちらを優先に使用かと迷いましたが、日付優先にしました。
これって、表の構築と言うか検索対象がはっきり決まっていないというのが盲点ですね。

Sub koshi2()
  Dim She1 As Worksheet, She3 As Worksheet
  Dim She1EdR As Long, She3EdR As Long, She3EdC As Long
  Dim I As Long, II As Long
  Dim FindN As Range, FindRag As Range, SacRag As Range
  Dim SacCo As Variant
  
  Set She1 = Sheets("Sheet1")
  Set She3 = Sheets("Sheet3")
  She1EdR = She1.Range("A65536").End(xlUp).Row
  She3EdR = She3.Range("A65536").End(xlUp).Row
  She3EdC = She3.Range("IV1").End(xlToLeft).Column
  Set SacRag = She1.Range("A1", She1.Range("IV1").End(xlToLeft))
  
  For I = 2 To She3EdC
    SacCo = Application.Match(She3.Cells(1, I).Value2, SacRag, 0)
    If Not IsError(SacCo) Then
      Set FindRag = She1.Range(She1.Cells(2, SacCo), She1.Cells(She1EdR, SacCo + 1))
      For II = 2 To She3EdR
        If She3.Cells(II, 1).Value <> "" Then
         Set FindN = FindRag.Find(She3.Cells(II, 1).Value, LookAt:=xlWhole)
         If Not FindN Is Nothing Then
           She3.Cells(II, I).Value = She1.Cells(FindN.Row, 1).Value
         Else
           She3.Cells(II, I).Value = ""
         End If
        Else
         She3.Cells(II, I).Value = ""
        End If
      Next
    Else
      She3.Range(Cells(2, I), Cells(She3EdR, I)).Value = "日付Err"
    End If
  Next
  Set She1 = Nothing
  Set She3 = Nothing
  Set SacRag = Nothing
  Set FindRag = Nothing
  Set FindN = Nothing
End Sub

3 hits

【10572】抽出したい koshimizu 04/2/2(月) 14:34 質問
【10588】Re:抽出したい INA 04/2/3(火) 8:40 回答
【10594】Re:抽出したい koshimizu 04/2/3(火) 10:37 質問
【10603】Re:抽出したい Jaka 04/2/3(火) 12:23 回答
【10611】Re:抽出したい koshimizu 04/2/3(火) 16:38 お礼
【10700】Re:抽出したい Jaka 04/2/9(月) 9:49 回答
【10707】Re:抽出したい koshimizu 04/2/9(月) 16:12 お礼

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