Excel VBA質問箱 IV

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

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


60 / 13292 ツリー ←次へ | 前へ→

【80354】カレンダーに予定を自動入力したい VBA初心者 19/1/31(木) 12:44 質問[未読]

【80418】Re:カレンダーに予定を自動入力したい VBA初心者 19/2/12(火) 9:28 回答[未読]
【80420】Re:カレンダーに予定を自動入力したい マナ 19/2/12(火) 19:30 発言[未読]
【80423】Re:カレンダーに予定を自動入力したい VBA初心者 19/2/13(水) 14:12 回答[未読]
【80424】Re:カレンダーに予定を自動入力したい マナ 19/2/13(水) 18:56 発言[未読]
【80428】Re:カレンダーに予定を自動入力したい VBA初心者 19/2/14(木) 10:46 回答[未読]
【80431】Re:カレンダーに予定を自動入力したい マナ 19/2/14(木) 19:16 発言[未読]
【80487】Re:カレンダーに予定を自動入力したい VBA初心者 19/2/18(月) 14:09 回答[未読]
【80493】Re:カレンダーに予定を自動入力したい マナ 19/2/18(月) 17:46 発言[未読]

【80418】Re:カレンダーに予定を自動入力したい
回答  VBA初心者  - 19/2/12(火) 9:28 -

引用なし
パスワード
   ▼マナ さん:
>▼VBA初心者 さん:
>
>>原因として考えられるのは、検索した結果(rngFound)がdと一つも当てはまらなかった場合の処理が入っていないということかなと思うのですが、その場合どうすればいいでしょうか?
>>
>>自分としてはIf Not rngFound Is Nothing Thenを使えばいいと思い、何度か組んでみたのですがすべてエラーになってしまうので、教えていただきたいです。
>
>最初の検索の直後に挿入するのでは?
>どのように試したのか提示してください。


マナ様

いつもお世話になっております。

Worksheet("Sheet1")に日付とスケジュール
Worksheet(1月〜12月)にカレンダーを表示させてあります。


Sub カレンダー入力新規()
  Dim ws1     As Worksheet
  Dim ws2     As Worksheet
  Dim lastRow   As Long
  Dim rngCalendar As Range
  Dim rngFound  As Range
  Dim rngFirstcell As Range
  Dim d      As Long
  Dim s      As String
  Dim k      As Long
  Dim i      As Long
  Dim j      As Long
  
  
  For j = 1 To 12

  Set ws1 = Worksheets("Sheet1")
  Set ws2 = Worksheets(j & " " & "月")
  lastRow = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
  
  Set rngCalendar = ws2.Range("A1:H14")


   For k = 1 To lastRow
     d = ws1.Cells(k, 1).Value '日付け
     s = ws1.Cells(k, 2).Value 'スケジュール
     i = CLng(d) '日付をシリアル値に変更
    
    
     Set rngFound = rngCalendar.Find(i, After:=rngCalendar(1), _
      LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
      MatchCase:=False, MatchByte:=False, SearchFormat:=False)
  
    
    If d = rngFound.Value Then
      Call setSchedule(rngFound.Offset(1, 0), s)
    
    Else
      Set rngFound = rngCalendar.FindNext(rngFound)
      
      If Not rngFound Is Nothing Then
        
        If d = rngFound.Value Then
          Call setSchedule(rngFound.Offset(1, 0), s)
    
        End If
      
      End If
    
    End If
  
   Next k
   
  Next j
  
End Sub

Function setSchedule(r As Range, s As String)
  If r.Value = "" Then
    r.Value = s
  Else
    r.Value = r.Value & vbLf & s
  End If
End Function

【80420】Re:カレンダーに予定を自動入力したい
発言  マナ  - 19/2/12(火) 19:30 -

引用なし
パスワード
   ▼VBA初心者 さん:

>Worksheet(1月〜12月)にカレンダーを表示させてあります。

まず、1月のシートだけで、ちゃんと動くものにしてください。

【80423】Re:カレンダーに予定を自動入力したい
回答  VBA初心者  - 19/2/13(水) 14:12 -

引用なし
パスワード
   ▼マナ さん:
>▼VBA初心者 さん:
>
>>Worksheet(1月〜12月)にカレンダーを表示させてあります。
>
>まず、1月のシートだけで、ちゃんと動くものにしてください。

マナ様
いつもお世話になっております。
お返事ありがとうございます。

1月のシートのみでしたらγ様が教えてくださったコードで動きました。

Sub カレンダー入力新規()
  Dim ws1     As Worksheet
  Dim ws2     As Worksheet
  Dim lastRow   As Long
  Dim rngCalendar As Range
  Dim rngFound  As Range
  Dim rngFirstcell As Range
  Dim d      As Long
  Dim s      As String
  Dim k      As Long
  Dim i      As Long
  Dim j      As Long
  

  Set ws1 = Worksheets("Sheet1")
  Set ws2 = Worksheets("1月")
  lastRow = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
  
  Set rngCalendar = ws2.Range("A1:H14")


   For k = 1 To lastRow
     d = ws1.Cells(k, 1).Value '日付け
     s = ws1.Cells(k, 2).Value 'スケジュール
     i = CLng(d) '日付をシリアル値に変更
    
    
     Set rngFound = rngCalendar.Find(i, After:=rngCalendar(1), _
      LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
      MatchCase:=False, MatchByte:=False, SearchFormat:=False)
  
    
    If d = rngFound.Value Then
      Call setSchedule(rngFound.Offset(1, 0), s)
    
    Else
      Set rngFound = rngCalendar.FindNext(rngFound)
      
      If Not rngFound Is Nothing Then
        
        If d = rngFound.Value Then
          Call setSchedule(rngFound.Offset(1, 0), s)
    
        End If
      
      End If
    
    End If
  
   Next k
  
End Sub

Function setSchedule(r As Range, s As String)
  If r.Value = "" Then
    r.Value = s
  Else
    r.Value = r.Value & vbLf & s
  End If
End Function


これです!

【80424】Re:カレンダーに予定を自動入力したい
発言  マナ  - 19/2/13(水) 18:56 -

引用なし
パスワード
   ▼VBA初心者 さん:

sheet1のA列とカレンダーの日付は
それぞれ、どんなデータなのでしょう?

1例ずつで構いませんので、例示お願いします。

【80428】Re:カレンダーに予定を自動入力したい
回答  VBA初心者  - 19/2/14(木) 10:46 -

引用なし
パスワード
   ▼マナ さん:
>▼VBA初心者 さん:
>
>sheet1のA列とカレンダーの日付は
>それぞれ、どんなデータなのでしょう?
>
>1例ずつで構いませんので、例示お願いします。

sheet1の

A列には
2019/1/25
2019/1/8
2019/1/25
2019/1/1

B列にはすべて
SAMPLE

と打ち込んでいます。

カレンダーには
エクセルの年カレンダー(1つのタブで1か月)というものを使っております。
表示されている日数は日付のみです。

宜しくお願い致します。

【80431】Re:カレンダーに予定を自動入力したい
発言  マナ  - 19/2/14(木) 19:16 -

引用なし
パスワード
   ▼VBA初心者 さん:

>カレンダーには
>エクセルの年カレンダー(1つのタブで1か月)というものを使っております。
>表示されている日数は日付のみです。


γさんの回答のように、Day(d)で検索しなくて大丈夫?
本当に、シリアル値 CLng(d)で検索ができていますか。

【80487】Re:カレンダーに予定を自動入力したい
回答  VBA初心者  - 19/2/18(月) 14:09 -

引用なし
パスワード
   ▼マナ さん:
>▼VBA初心者 さん:
>
>>カレンダーには
>>エクセルの年カレンダー(1つのタブで1か月)というものを使っております。
>>表示されている日数は日付のみです。
>
>
>γさんの回答のように、Day(d)で検索しなくて大丈夫?
>本当に、シリアル値 CLng(d)で検索ができていますか。

Day(d)で検索するマクロを考えてみました。
ですが、これだとエラーは出ないものの正しく入力されませんでした。
なぜ入力されないか教えていただきたいです。

Sub カレンダー入力新規2()

  Dim ws1     As Worksheet
  Dim lastRow   As Long
  Dim rngCalendar As Range
  Dim rngFound   As Range
  Dim rngFirstcell As Range
  
  Dim A      As Long
  
  Dim h      As Long
  Dim i      As String
  Dim j      As Long
  Dim k      As Long
  Dim l      As String
  
  Set ws1 = Worksheets("Sheet1")
  lastRow = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
  
  For A = 1 To lastRow
  
     h = ws1.Cells(A, 1).Value '日付け
     i = ws1.Cells(A, 2).Value 'スケジュール
     j = Month(d)        '日付から月を抜く
     k = Day(d)         '日付から日を抜く
   
     
  If j = 1 Then
   Set rngCalendar = Worksheets(1 & " " & "月").Range("B3:H13")
  ElseIf j = 2 Then
   Set rngCalendar = Worksheets(2 & " " & "月").Range("B3:H13")
  ElseIf j = 3 Then
   Set rngCalendar = Worksheets(3 & " " & "月").Range("B3:H13")
  ElseIf j = 4 Then
   Set rngCalendar = Worksheets(4 & " " & "月").Range("B3:H13")
  ElseIf j = 5 Then
   Set rngCalendar = Worksheets(5 & " " & "月").Range("B3:H13")
  ElseIf j = 6 Then
   Set rngCalendar = Worksheets(6 & " " & "月").Range("B3:H13")
  ElseIf j = 7 Then
   Set rngCalendar = Worksheets(7 & " " & "月").Range("B3:H13")
  ElseIf j = 8 Then
   Set rngCalendar = Worksheets(8 & " " & "月").Range("B3:H13")
  ElseIf j = 9 Then
   Set rngCalendar = Worksheets(9 & " " & "月").Range("B3:H13")
  ElseIf j = 10 Then
   Set rngCalendar = Worksheets(10 & " " & "月").Range("B3:H13")
  ElseIf j = 11 Then
   Set rngCalendar = Worksheets(11 & " " & "月").Range("B3:H13")
  ElseIf j = 12 Then
   Set rngCalendar = Worksheets(12 & " " & "月").Range("B3:H13")
  End If


  Set rngFound = rngCalendar.Find(k, After:=rngCalendar(1), _
      LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
      MatchCase:=False, MatchByte:=False, SearchFormat:=False)
  
    
    If k = rngFound.Value Then
      Call setSchedule(rngFound.Offset(1, 0), l)
    
    Else
      Set rngFound = rngCalendar.FindNext(rngFound)
      
      If Not rngFound Is Nothing Then
        
        If d = rngFound.Value Then
          Call setSchedule(rngFound.Offset(1, 0), l)
   
        End If
      
      End If
    
    End If
   
  Next A
   
End Sub

Function setSchedule(r As Range, l As String)
  If r.Value = "" Then
    r.Value = l
  Else
    r.Value = r.Value & vbLf & l
  End If
End Function


End Function

【80493】Re:カレンダーに予定を自動入力したい
発言  マナ  - 19/2/18(月) 17:46 -

引用なし
パスワード
   ▼VBA初心者 さん:

申し訳ありませんが1月だけのコードで議論させていただけませんか。

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