Excel VBA質問箱 IV

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

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


42485 / 76732 ←次へ | 前へ→

【39315】2006/7月分のみ抽出したい場合
質問  サン E-MAIL  - 06/6/22(木) 10:59 -

引用なし
パスワード
   御忙しい所、申し訳ございません。
下記のマクロを作成しましたがうまく動きません。
2006/7の入金予定分を他のシートにコピーしたいのですが
教えて頂けますでしょうか。

宜しくお願い致します。

Sub データ抽出販売()
'---------------------------宣言セクション(各項目 最大1000件まで格納する)---
Dim 顧客コード(1000) As String
Dim 顧客名(1000) As String
Dim 部署(1000) As String
Dim 担当者(1000) As String
Dim 売上日(1000) As Date
Dim 伝票番号(1000) As Single
Dim 売上金額(1000) As Single
Dim 未収金額(1000) As Single
Dim 備考(1000) As String
Dim 入金予定(1000) As Date
Dim 入金情報(1000) As String
Dim 当社担当(1000) As String
Dim UHNAMK(1000) As String


Dim n As Integer
Dim m As Integer
Dim i As Integer

Dim mstr As String


'-----------------------メッセージボックスの表示------------------------------
mstr = InputBox("何月分を抽出しますか?(数字のみ)", "抽出月指定")

'----------------------該当データを一旦メモリ上に格納する---------------------
Sheets("販売").Select
n = 0
Range("J1").Select

Do While ActiveCell <> "" '----------A列で空欄がくるまで繰り返す
      
  If Month(ActiveCell) = Val(mstr) Then '----メッセージボックスで入力した月のデータを格納
      顧客コード(n) = ActiveCell.Cells.Value
      ActiveCell.Offset(0, 1).Select
      顧客名(n) = ActiveCell.Cells.Value
      ActiveCell.Offset(0, 1).Select
      部署(n) = ActiveCell.Cells.Value
      ActiveCell.Offset(0, 1).Select
      担当者(n) = ActiveCell.Cells.Value
      ActiveCell.Offset(0, 1).Select
      売上日(n) = ActiveCell.Cells.Value
      ActiveCell.Offset(0, 1).Select
      伝票番号(n) = ActiveCell.Cells.Value
      ActiveCell.Offset(0, 1).Select
      売上金額(n) = ActiveCell.Cells.Value
      ActiveCell.Offset(0, 1).Select
      未収金額(n) = ActiveCell.Cells.Value
      ActiveCell.Offset(0, 1).Select
      備考(n) = ActiveCell.Cells.Value
      ActiveCell.Offset(0, 1).Select
      入金予定(n) = ActiveCell.Cells.Value
      ActiveCell.Offset(0, 1).Select
      入金情報(n) = ActiveCell.Cells.Value
      ActiveCell.Offset(0, 1).Select
      当社担当(n) = ActiveCell.Cells.Value
      ActiveCell.Offset(0, 1).Select
      UHNAMK(n) = ActiveCell.Cells.Value
      ActiveCell.Offset(0, -12).Select
          
      
      n = n + 1
   Else
     
    End If
    ActiveCell.Offset(1, 0).Select
  Loop
  

'----------------------抽出シート作成----------------------------------------
 
  Sheets.Add After:=Worksheets(Worksheets.Count) '----------シート挿入
  ActiveSheet.Name = mstr & "月分"        '----------シート名
   
  
  ActiveSheet.Range("A1").Select
  
    ActiveCell.Cells.Value = "顧客コード"     '----------項目名
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Cells.Value = "顧客名"
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Cells.Value = "部署"
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Cells.Value = "担当者"
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Cells.Value = "売上日"
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Cells.Value = "伝票番号"
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Cells.Value = "売上金額"
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Cells.Value = "未収金額"
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Cells.Value = "備考"
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Cells.Value = "入金予定"
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Cells.Value = "入金情報"
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Cells.Value = "当社担当"
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Cells.Value = "UHNAMK"
    ActiveCell.Offset(1, -13).Select


  For i = 0 To n - 1              '-----------メモリ上に格納していたデータを代入
    ActiveCell.Cells.Value = 顧客コード(i)
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Cells.Value = 顧客名(i)
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Cells.Value = 部署(i)
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Cells.Value = 担当者(i)
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Cells.Value = 売上日(i)
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Cells.Value = 伝票番号(i)
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Cells.Value = 売上金額(i)
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Cells.Value = 未収金額(i)
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Cells.Value = 備考(i)
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Cells.Value = 入金予定(i)
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Cells.Value = 入金情報(i)
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Cells.Value = 当社担当(i)
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Cells.Value = UHNAMK(i)
    ActiveCell.Offset(1, -13).Select


  Next i
  
  ActiveSheet.Range("A1").Select


End Sub

0 hits

【39315】2006/7月分のみ抽出したい場合 サン 06/6/22(木) 10:59 質問
【39317】Re:2006/7月分のみ抽出したい場合 Jaka 06/6/22(木) 11:13 発言
【39318】Re:2006/7月分のみ抽出したい場合 サン 06/6/22(木) 11:20 お礼
【39321】Re:2006/7月分のみ抽出したい場合 ハト 06/6/22(木) 11:39 発言
【39325】Re:2006/7月分のみ抽出したい場合 サン 06/6/22(木) 11:45 発言
【39337】Re:2006/7月分のみ抽出したい場合 ハト 06/6/22(木) 13:37 発言
【39340】Re:2006/7月分のみ抽出したい場合 サン 06/6/22(木) 14:26 発言
【39342】Re:2006/7月分のみ抽出したい場合 ハト 06/6/22(木) 14:45 回答
【39345】Re:2006/7月分のみ抽出したい場合 サン 06/6/22(木) 15:00 お礼
【39347】Re:2006/7月分のみ抽出したい場合 ハト 06/6/22(木) 15:07 発言
【39349】Re:2006/7月分のみ抽出したい場合 サン 06/6/22(木) 15:17 お礼
【39350】Re:2006/7月分のみ抽出したい場合 サン 06/6/22(木) 15:20 お礼

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