| |
▼ハト さん：
有難うございます。
大変申し訳ないのですが、
TDate = WS1.Cells(i + 1, "J")
の所が黄色になって止まってしまいます。
なぜなのかわからないので、
何度も大変申し訳ございませんが
教えて頂けますでしょうか。
御忙しい所、申し訳ございません。
>▼サン さん：
>>
>> Ａ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(木) 15:00 -
