| |
▼サン さん：
>
> Ａ1 Ｂ1 Ｃ1 Ｄ1 Ｅ1 Ｆ1 Ｇ1
>顧客コード 顧客名 部署 担当者 売上日 伝票番号 売上金額
>1000000 ×× ×× ×× 2006/01/01 000000 100,000
>
> Ｈ1 Ｉ1 Ｊ1 Ｋ1 Ｌ1 Ｍ1
>未収金額 備考 入金予定 入金情報 当社担当 UHNAMK
>100,000 ×× 2006/07/01 ×× ×× ××
>
>とエクセルのファイルになっています。
>
>質問１の回答ですが・・・
>申し訳ございません。
>あの数式で年と月を選択してくれるものだと思っていました。
>
>質問２の回答ですが・・・
>上記の記入で解りますでしょうか。
>
>何度も何度も申し訳ございません。
>
どうもSELECT、OFFSET を使っていて混乱なされていたようですね
こういうケースではSelectを使わないでやる方法の方が良さそうです
サンさんのを元に作ると次のような感じですね
お試しください
（まだ改善の余地はありそうですが・・・）
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 i As Integer
Dim mstr As String
Dim WS1 As Worksheet
Dim WS2 As Worksheet
Dim TDate As Date
Dim SName As String
'-----------------------メッセージボックスの表示------------------------------
mstr = InputBox("何月分を抽出しますか？(数字のみ）", "抽出月指定")
'----------------------該当データを一旦メモリ上に格納する---------------------
Set WS1 = ThisWorkbook.Worksheets("販売")
n = 0
i = 0
Do While WS1.Cells(i + 1, "A") <> "" '----------A列で空欄がくるまで繰り返す
TDate = WS1.Cells(i + 1, "J")
If Year(TDate) = Year(mstr) And Month(TDate) = Month(mstr) Then '----メッセージボックスで入力した月のデータを格納
顧客コード(n) = WS1.Cells(i + 1, "A").Value
顧客名(n) = WS1.Cells(i + 1, "B").Value
部署(n) = WS1.Cells(i + 1, "C").Value
担当者(n) = WS1.Cells(i + 1, "D").Value
売上日(n) = WS1.Cells(i + 1, "E").Value
伝票番号(n) = WS1.Cells(i + 1, "F").Value
売上金額(n) = WS1.Cells(i + 1, "G").Value
未収金額(n) = WS1.Cells(i + 1, "H").Value
備考(n) = WS1.Cells(i + 1, "I").Value
入金予定(n) = WS1.Cells(i + 1, "J").Value
入金情報(n) = WS1.Cells(i + 1, "K").Value
当社担当(n) = WS1.Cells(i + 1, "L").Value
UHNAMK(n) = WS1.Cells(i + 1, "M").Value
n = n + 1
End If
i = i + 1
Loop
'----------------------抽出シート作成----------------------------------------
Sheets.Add After:=Worksheets(Worksheets.Count) '----------シート挿入
SName = Year(mstr) & "-" & Month(mstr) & "月分" '----------シート名（シート名に『/』は使えない）
ActiveSheet.Name = SName
Set WS2 = ThisWorkbook.Worksheets(SName)
WS2.Range("A1").Value = "顧客コード" '----------項目名
WS2.Range("B1").Value = "顧客名"
WS2.Range("C1").Value = "部署"
WS2.Range("D1").Value = "担当者"
WS2.Range("E1").Value = "売上日"
WS2.Range("F1").Value = "伝票番号"
WS2.Range("G1").Value = "売上金額"
WS2.Range("H1").Value = "未収金額"
WS2.Range("I1").Value = "備考"
WS2.Range("J1").Value = "入金予定"
WS2.Range("K1").Value = "入金情報"
WS2.Range("L1").Value = "当社担当"
WS2.Range("M1").Value = "UHNAMK"
For i = 0 To n - 1 '-----------メモリ上に格納していたデータを代入
WS2.Cells(i + 2, "A").Value = 顧客コード(i)
WS2.Cells(i + 2, "B").Value = 顧客名(i)
WS2.Cells(i + 2, "C").Value = 部署(i)
WS2.Cells(i + 2, "D").Value = 担当者(i)
WS2.Cells(i + 2, "E").Value = 売上日(i)
WS2.Cells(i + 2, "F").Value = 伝票番号(i)
WS2.Cells(i + 2, "G").Value = 売上金額(i)
WS2.Cells(i + 2, "H").Value = 未収金額(i)
WS2.Cells(i + 2, "I").Value = 備考(i)
WS2.Cells(i + 2, "J").Value = 入金予定(i)
WS2.Cells(i + 2, "K").Value = 入金情報(i)
WS2.Cells(i + 2, "L").Value = 当社担当(i)
WS2.Cells(i + 2, "M").Value = UHNAMK(i)
Next i
WS2.Range("A1").Select
Set WS1 = Nothing
Set WS2 = Nothing
End Sub
|
|
ハト
- 06/6/22(木) 14:45 -
