DBに登録。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 |
Application.StatusBar = "データアップロード中..." On Error GoTo try Set con = CreateObject("adodb.connection") con.Open "provider=microsoft.jet.oledb.4.0;data source=" & ActiveWorkbook.Path & "\yayoi.mdb" con.Execute "delete from tbl" Set w = Sheets("貼付") For r = 9 To w.UsedRange.Rows.Count If w.Cells(r, 1).Value = "[明細行]" Then w.Cells(r, 2).NumberFormatLocal = "yyyy/mm/dd" If w.Cells(r, 15).Text = "" Then w.Cells(r, 15).Value = 0 If w.Cells(r, 16).Text = "" Then w.Cells(r, 16).Value = 0 If w.Cells(r, 22).Text = "" Then w.Cells(r, 22).Value = 0 If w.Cells(r, 23).Text = "" Then w.Cells(r, 23).Value = 0 q = "insert into tbl (" & _ "日付,借方勘定科目,借方補助科目,借方部門,借方金額,借方税額,貸方勘定科目,貸方補助科目,貸方部門,貸方金額,貸方税額,摘要" & _ ") values (" & _ "'" & w.Cells(r, 2).Text & "'," & _ "'" & w.Cells(r, 10).Text & "'," & _ "'" & w.Cells(r, 11).Text & "'," & _ "'" & w.Cells(r, 12).Text & "'," & _ " " & w.Cells(r, 15).Text & " ," & _ " " & w.Cells(r, 16).Text & " ," & _ "'" & w.Cells(r, 17).Text & "'," & _ "'" & w.Cells(r, 18).Text & "'," & _ "'" & w.Cells(r, 19).Text & "'," & _ " " & w.Cells(r, 22).Text & " ," & _ " " & w.Cells(r, 23).Text & " ," & _ "'" & w.Cells(r, 24).Text & "');" con.Execute q: Debug.Print q End If Next r If con.State = 1 Then con.Close Application.StatusBar = False InsertDb = True Exit Function try: If con.State = 1 Then con.Close Application.StatusBar = False MsgBox Err.Description InsertDb = False |
DBから取り出す。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 |
Application.StatusBar = "データ取得中..." On Error GoTo try Set con = CreateObject("adodb.connection") Set rec = CreateObject("adodb.recordset") con.Open "provider=microsoft.jet.oledb.4.0;data source=" & ActiveWorkbook.Path & "\yayoi.mdb" Set w = Sheets("集計") w.Activate w.Cells.Delete i = 1 w.Cells(i, 1).Value = "売上" i = w.UsedRange.Rows.Count + 1 rec.Open "select '生産者売上高','-',sum(貸方金額)-sum(貸方税額) from tbl where 貸方勘定科目 = '生産者売上高'", con w.Cells(i, 2).CopyFromRecordset rec rec.Close i = w.UsedRange.Rows.Count + 1 w.Cells(i, 1).Value = "売上/補助" i = w.UsedRange.Rows.Count + 1 rec.Open "select '生産者売上高',貸方補助科目,sum(貸方金額)-sum(貸方税額) from tbl where 貸方勘定科目 = '生産者売上高' group by 貸方補助科目" w.Cells(i, 2).CopyFromRecordset rec rec.Close w.Columns.AutoFit If con.State = 1 Then con.Close Application.StatusBar = False SelectDb = True Exit Function try: If con.State = 1 Then con.Close Application.StatusBar = False MsgBox Err.Description SelectDb = False |
該当アドレスを取り出す。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 |
Set w = Sheets("集計") For r = 1 To w.UsedRange.Rows.Count If w.Cells(r, 2).Text = op1 And w.Cells(r, 3).Text = op2 Then SearchText = w.Cells(r, 4).Address(rowabsolute:=False, columnabsolute:=False) Exit Function End If Next r SearchText = "A2" |
関数登録
|
1 |
w.Cells(13, 5).Value = "=集計!" & SearchText("業者仕入高", "加工他（買取）") |