Excel VBA質問箱 IV

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

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


66693 / 76734 ←次へ | 前へ→

【14603】Re:CSVファイルを読み込む
回答  Hirofumi  - 04/6/2(水) 21:11 -

引用なし
パスワード
   少し書きなおしてコメントを入れて置きました
なお、前は範囲をCopyして張りつけていたのですが
今回、範囲の値を代入しています

また、前回のエラーは私のボケで、lngRowの値が決まる前に使用していました
目的は、範囲をクリアする事です

それと、前回、実行ファイルのBookに記述しなさいと書きましたが
月報フォーマットのBookに同様に書いても動くと思います

書き直したコードを記述します

ThisWorkbookのコードモジュールに以下を記述して下さい

Private Sub Workbook_Open()

  Dim i As Long
  
  With Worksheets("Sheet1").ComboBox1
    For i = 0 To 23
      .AddItem i & "時"
    Next i
  End With
    
End Sub

Sheet1のコードモジュールに以下を記述して下さい

Private Sub CommandButton1_Click()
  
  With Me.ComboBox1
    If .ListIndex <> -1 Then
      DataCopy Val(.Value)
    End If
  End With
  
End Sub

標準モジュールに以下を記述して下さい

Option Explicit

Public Sub DataCopy(ByVal lngTime As Long)

  Const strBookName As String = "月報フォーマット.xls"
  Const strResult As String = "月報"
  
  Dim blnExists As Boolean
  Dim wkbData As Workbook
  Dim wksDaTa As Worksheet
  Dim wksResult As Worksheet
  Dim lngRow As Long
  
  '"月報フォーマット.xls"がOpenされているか確認
  'Workbooksコレクションの全てを繰り返す
  For Each wkbData In Workbooks
    'コレクションの要素の名前が、"月報フォーマット.xls"なら
    If wkbData.Name = strBookName Then
      '存在フラグをTrueに
      blnExists = True
      Exit For
    End If
  Next wkbData
  'Openされていない場合
  If Not blnExists Then
    Beep
    MsgBox "月報フォーマット.xlsがOpenされていません"
    Exit Sub
  End If
  
  '指定された時間の行位置を取得
  lngTime = lngTime + 4
  
  '"月報フォーマット.xls"に就いて
  With Workbooks(strBookName)
    'アクティブに
    .Activate
    '"月報"シートの参照を設定
    Set wksResult = .Worksheets(strResult)
    '"月報"シートのB9:R39をクリア
    wksResult.Cells(9, _
          "B").Resize(31, 17).ClearContents
    'WorkSheetsコレクションの全てを繰り返す
    For Each wksDaTa In .Worksheets
      'コレクションの要素の就いて
      With wksDaTa
        'シート名が"月報"で無いなら
        If .Name <> strResult Then
          'シート名の右二文字を取り出して数値に変換
          '日付を取り出す
          lngRow = Val(Right(.Name, 2))
          '取り出した日付が日付で有るなら
          If lngRow > 0 Then
            '日付を行位置に変換
            lngRow = lngRow + 9 - 1
            '時間の有る行位置の範囲の値を
            '日付の有る行位置の範囲に代入
            wksResult.Cells(lngRow, "B").Resize(, 17).Value _
                = .Cells(lngTime, "B").Resize(, 17).Value
          End If
        End If
      End With
    Next wksDaTa
  End With
  
  Set wksResult = Nothing
  Set wksDaTa = Nothing
  Set wkbData = Nothing
  
  Beep
  MsgBox "処理が完了しました"

End Sub
0 hits

【14281】CSVファイルを読み込む アスキー 04/5/25(火) 14:45 質問
【14284】Re:CSVファイルを読み込む ちゃっぴ 04/5/25(火) 15:20 回答
【14291】Re:CSVファイルを読み込む アスキー 04/5/25(火) 15:43 発言
【14294】Re:CSVファイルを読み込む ちゃっぴ 04/5/25(火) 15:51 発言
【14295】Re:CSVファイルを読み込む アスキー 04/5/25(火) 16:07 質問
【14299】Re:CSVファイルを読み込む ちゃっぴ 04/5/25(火) 16:26 回答
【14306】Re:CSVファイルを読み込む アスキー 04/5/25(火) 17:01 回答
【14307】Re:CSVファイルを読み込む ちゃっぴ 04/5/25(火) 17:11 回答
【14310】Re:CSVファイルを読み込む アスキー 04/5/25(火) 18:16 発言
【14312】Re:CSVファイルを読み込む [名前なし] 04/5/25(火) 18:59 回答
【14315】Re:CSVファイルを読み込む Hirofumi 04/5/25(火) 21:05 回答
【14317】Re:CSVファイルを読み込む Hirofumi 04/5/25(火) 21:44 回答
【14399】Re:CSVファイルを読み込む アスキー 04/5/28(金) 9:11 発言
【14517】Re:CSVファイルを読み込む アスキー 04/5/31(月) 17:50 質問
【14527】Re:CSVファイルを読み込む Hirofumi 04/5/31(月) 20:33 発言
【14536】Re:CSVファイルを読み込む アスキー 04/6/1(火) 1:33 質問
【14562】Re:CSVファイルを読み込む Hirofumi 04/6/1(火) 22:43 回答
【14573】Re:CSVファイルを読み込む アスキー 04/6/2(水) 10:11 質問
【14598】Re:CSVファイルを読み込む アスキー 04/6/2(水) 17:38 発言
【14603】Re:CSVファイルを読み込む Hirofumi 04/6/2(水) 21:11 回答
【14632】Re:CSVファイルを読み込む アスキー 04/6/3(木) 12:42 お礼

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