Excel VBA質問箱 IV

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

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


24877 / 76732 ←次へ | 前へ→

【57201】Re:CSVデータをACCESSに移行2.
質問  satsuki  - 08/7/31(木) 14:26 -

引用なし
パスワード
   ▼かみちゃん さん:
レスありがとうございます。

>変数 i と j の関係がよくわかりません。
>お手数ですが、長くなってもいいので、コード全体を差し支えない程度に掲載していただ
>くことはできませんか?

ありがとうございます。では、お言葉に甘えまして書かせて頂きます。
実際のデータを出すことはできませんので、同じパターンのデータを例にしてみました。前回はわかりやすくインデントして書きましたが、実際はすべてA列B列に表示されています。
1日ごとにCSVデータが出力され、各行に日付を入れて1件のデータにしていこうとしています。最終的には項目と日付のクロス集計をACCESSから出力します。

データ処理日
2008年7月15日

1.店別来店数
A店  550
B店  360
C店  480

2.店別製品別売上数
A店
製品1 15
製品2 26
B店
製品1 28
製品3 45
C店
製品2 35
製品4 12

3.店別個人別売上数
A店
製品1 
担当A 6
担当B 9
製品2
担当B 6
担当C 20 
B店
製品1 
担当D 9
担当E 15
担当F 4
製品3
担当D 24
担当E 21
C店
製品2
担当G 7
担当H 12
担当F 16
製品4 
担当G 2
担当H 7
担当F 3


Dim SearchWord As String
Dim kiten As Range
Dim kiten2 As Variant
Dim hiduke as string
Dim tenpo As String
Dim shohin As String
Dim i As Integer
Dim j As Integer

Dim Title(2) As String
Dim TitleName As String
Dim TableName(2) As String
Dim InputTable As String

Dim CN As ADODB.Connection
Dim RS As ADODB.Recordset
Dim strSQL As String

Dim hiduke As String

Set CN = New ADODB.Connection
CN.provider = "Microsoft.Jet.OLEDB.4.0"
CN.Open "C:\My Documents\bunseki.mdb"

Title(0) = "1.店別来店数"
Title(1) = "2.店別製品別売上数"
Title(2) = "3.店別個人別売上数"

TableName(0) = "raiten"
TableName(1) = "seihinbetsu"
TableName(2) = "kojinbetsu

Range("A1").Select

SearchWord = "*年*月*日*"
Set kiten = Worksheets("Sheet1").Columns(1).Find(What:=SearchWord, LookIn:=xlValues, LookAt:=xlWhole)

If Not kiten Is Nothing Then
  hiduke = kiten
End If

TitleName = Title(0)
InputTable = TableName(0)
i = 0

SearchWord = Title(0)
Set kiten2 = Worksheets("Sheet1").Columns(1).Find(What:=SearchWord, LookIn:=xlValues, LookAt:=xlWhole)
If kiten2 Is Nothing Then
  Exit Sub
End If

For j = kiten2.Row + 1 To Range("A65536").End(xlUp).Row
  Cells(j, 1).Activate
  ↓空白セルはとばす。
  If IsNull(ActiveCell.Value) Or ActiveCell.Value = "" Then
    Cells(j + 1, 1).Activate
    j = j + 1
  End If
  ↓タイトル行が出てきたら、変数に入れて、1行下にフォーカスをずらす。
  If ActiveCell.Value = Title(i + 1) Then
    TitleName = Title(i + 1)
    InputTable = TableName(i + 1)
    Cells(j + 1, 1).Activate
    i = i + 1
    j = j + 1
  End If
  ↓1件ごとのデータに共通の値を変数で保持。
  If ActiveCell.Value Like "*店" Then
    tenpo = Cells(j, 1)
  ElseIf ActiveCell.Value Like "製品*" Then
    shohin = Cells(j, 1)
  Else
    Set RS = New ADODB.Recordset
    strSQL = "select * from " & InputTable
    
    RS.Open strSQL, CN, adOpenStatic, adLockOptimistic, adCmdText
        
    Select Case TitleName
    Case "1.店別来店数"
      RS.addnew
        RS!日付 = kiten
        RS!店名 = Cells(j, 1).Value
        RS!人数 = Cells(j, 2).Value
      RS.Update
    Case "2.店別製品別売上数"
      RS.addnew
        RS!日付 = kiten
        RS!店名 = tenpo
        RS!製品名 = Cells(j, 1).Value
        RS!台数 = Cells(j, 2).Value
      RS.Update
    Case "3.店別個人別売上数"
      RS.addnew
        RS!日付 = kiten
        RS!店名 = tenpo
        RS!製品名 = shohin
        RS!担当名 = Cells(j, 1).Value
        RS!台数 = Cells(j, 2).Value
      RS.Update
     End Select
  End If
  
Next j

RS.Close
CN.Close

End Sub


全く別のやり方でも構いません。もっといい方法がありましたら、ご教授よろしくお願いいたします。

0 hits

【57168】CSVデータをACCESSに移行2. satsuki 08/7/30(水) 16:13 質問
【57183】Re:CSVデータをACCESSに移行2. neptune 08/7/30(水) 22:31 発言
【57188】Re:CSVデータをACCESSに移行2. satsuki 08/7/31(木) 0:47 質問
【57189】Re:CSVデータをACCESSに移行2. かみちゃん 08/7/31(木) 0:56 発言
【57194】Re:CSVデータをACCESSに移行2. satsuki 08/7/31(木) 11:23 質問
【57196】Re:CSVデータをACCESSに移行2. かみちゃん 08/7/31(木) 12:47 発言
【57201】Re:CSVデータをACCESSに移行2. satsuki 08/7/31(木) 14:26 質問
【57207】Re:CSVデータをACCESSに移行2. neptune 08/7/31(木) 21:52 回答
【57208】Re:CSVデータをACCESSに移行2. satsuki 08/8/1(金) 1:08 発言
【57192】Re:CSVデータをACCESSに移行2. neptune 08/7/31(木) 10:25 発言
【57193】Re:CSVデータをACCESSに移行2. satsuki 08/7/31(木) 11:13 発言
【57198】Re:CSVデータをACCESSに移行2. neptune 08/7/31(木) 13:33 発言
【57209】Re:CSVデータをACCESSに移行2. satsuki 08/8/1(金) 1:14 発言
【57210】Re:CSVデータをACCESSに移行2. かみちゃん 08/8/1(金) 7:14 発言
【57222】Re:CSVデータをACCESSに移行2. satsuki 08/8/1(金) 19:37 質問
【57220】Re:CSVデータをACCESSに移行2. neptune 08/8/1(金) 16:18 発言
【57221】Re:CSVデータをACCESSに移行2. satsuki 08/8/1(金) 19:31 質問
【57225】Re:CSVデータをACCESSに移行2. かみちゃん 08/8/1(金) 21:28 発言
【57230】Re:CSVデータをACCESSに移行2. satsuki 08/8/2(土) 1:14 お礼
【57231】Re:CSVデータをACCESSに移行2. かみちゃん 08/8/2(土) 9:56 発言
【57232】Re:CSVデータをACCESSに移行2. neptune 08/8/2(土) 11:08 発言
【57227】Re:CSVデータをACCESSに移行2. neptune 08/8/1(金) 22:20 発言
【57244】Re:CSVデータをACCESSに移行2. satsuki 08/8/2(土) 18:12 お礼

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