エクセルで決算書作成マクロを作成したい

このQ&Aのポイント
  • 私は自治会の決算書を作成したいです。そのために、エクセルで決算書作成のためのマクロを作成しようとしています。
  • 具体的には、特定のセルから値を取得して他の範囲内で一致する文字列を検索し、該当するセルの値を取得して計算したいと思っています。
  • しかし、範囲内から値を取得する方法や、一致する文字列のセルの隣の値を取得する方法がわからず、解決策を求めています。
回答を見る
  • ベストアンサー

エクセル 決算マクロ

Dim s Dim h As String Private Sub Worksheet_SelectionChange(ByVal Target As Range) h = Sheets("決算").Cells(3, 2).Value For Each ws In Worksheets s = ws.Index Next ws For k = 5 To s Step 1 Set KaMoku = Sheets(k).Range("D3:J103").Columns(1) MyRNo = Application.WorksheetFunction.Match(h, KaMoku, 0) MyUNo = KaMoku.Cells(MyRNo).Offset(, 4) n = n + MyUNo Sheets("決算").Cells(3, 5).Value = n Next k End Sub 自治会の決算書を作りたいので上記のようなマクロを、インターネットで調べながら 私の知識のない頭をフル回転させて書いてみたのですが。 h = Sheets("決算").Cells(3, 2).Valueで、hへの値の代入が一つのセルからの代入ではなくて h = Sheets("決算").Range("B3:B103").Valueのように範囲から文字をさがしたいのです。 それと MyRNo = Application.WorksheetFunction.Match(h, KaMoku, 0) AND MySNo = Application.WorksheetFunction.Match(K, KoKaMoku, 0) のように、この文字が同じで、次の列のこの文字も同じ時に MyUNo = KaMoku.Cells(MySNo).Offset(, 4) 4列目の値を n = n + MyUNo Sheets("決算").Cells(3, 5).Value =(ではなくて) ここも、一致した文字のあるセルの隣のセルに数値を入れたいのですが、うまくいきません。どうか私に、あなたの素晴らしい知恵をかしてください。 お願いします。

質問者が選んだベストアンサー

  • ベストアンサー
回答No.1

書いてある内容が半分ほどしか理解できなかったため、憶測でよければ参考にしてください。 >h = Sheets("決算").Range("B3:B103").Valueのように範囲から文字をさがしたいのです。 複数セルの値を格納したいのであれば、Variant型(数値)を使用すれば値を取得できます。 例:  Dim getTargetVal() As Variant 配列で値を保持しているため、値を取り出したい場合は、For文などで繰返し処理を使用します。 >MyRNo = Application.WorksheetFunction.Match(h, KaMoku, 0) AND >MySNo = Application.WorksheetFunction.Match(K, KoKaMoku, 0) >のように、この文字が同じで、次の列のこの文字も同じ時に >MyUNo = KaMoku.Cells(MySNo).Offset(, 4) 4列目の値を 値を取得する条件を指定した場合はIF文を使用します。 ただし、Match関数は一致するものがない場合、N/Aを返すため、IsError関数で制御 IsErrorは、エラーが出た場合Trueを返す If IsError(Application.Match(範囲, 範囲, 0)) = False Then やりたい処理 End IF

tetsuokouchi
質問者

お礼

早速回答して頂いてありがとうございます。 私の書き方が悪かった尾で、聞きたい事の内容が把握しずらくすみません。 私のやりたい事は 現金出納帳シートのA列(大科目)B列(小科目)の文字列の中の 大科目(たとえば会費・入会金)小科目(たとえば会費) この二つの文字が、決算シートのA列(大科目)の範囲のB列(小科目)の同じ文字の行の右隣のセルに、出納帳に入力した数値を入れたいのです。 1つは宣言の型が悪かったのですね、Matchに対してのIFの使い方がわからなかったので何となく分かりました。近いうちに試してみます。 私みたいな素人にみ分かりやすい回答をしていただいて、大変感謝しています。 ありがとうございます。 また質問をさせて頂くと思いますので、その時はよろしくお願いします。

関連するQ&A

  • エクセル マクロ Matchの使い方

    前回の質問で、大変親切に回答して頂き、大変感謝しております。 でも、私自身がこの質問サイトのルールを把握していなっかたので、まだ問題が解決していないのに、親切に回答してくださった方を、ベストアンサーに選んでしまいました。 でも、まだ問題が解決していないので、再度質問をさせて頂きます。 私のやりたい事は下記のような事です。 現金出納帳シートのA列(大科目)B列(小科目)の文字列の中の 大科目(たとえば会費・入会金)小科目(たとえば会費) この二つの文字が、決算シートのA列(大科目)の範囲のB列(小科目)の同じ文字と一致したときに 現金出納帳シートのB列(小科目)の一致した文字の行の4列目の数値を決算シートのB列(小科目)の同じ文字の行の右隣のセルに、出納帳に入力した数値を入れたいのです。 前回の回答を参考に、下記のようなマクロを試してみたのですがどうしてもうまくいくません。 Dim s Dim h As Variant Private Sub Worksheet_SelectionChange(ByVal Target As Range) h = Sheets("決算").Range("B3:B103").Value For Each ws In Worksheets s = ws.Index Next ws For K = 5 To s Step 1 Set KaMoku = Sheets(K).Range("D3:J103").Columns(1) Next K If IsError(Application.Match(h, KaMoku, 0)) = False Then この用にするとここでエラーになります。 MyRNo = Application.WorksheetFunction.Match(h, KaMoku, 0) 実行時エラー方が一致しません MyUNo = KaMoku.Cells(MyRNo).Offset(, 4) N = N + MyUNo Sheets("決算").Cells(3, 5).Value = N End If End Sub もう一例 Dim s Dim h As Variant Private Sub Worksheet_SelectionChange(ByVal Target As Range) h = Sheets("決算").Range("B3:B103").Value For Each ws In Worksheets s = ws.Index Next ws For K = 5 To s Step 1 Set KaMoku = Sheets(K).Range("D3:J103").Columns(1) Next K If IsError(Application.Match(h, KaMoku, 0)) = False Then では、.WorksheetFunctionがいけないのかと思って、この用にすると、アプリケーション定義と出ます。 MyRNo = Application.Match(h, KaMoku, 0) MyUNo = KaMoku.Cells(MyRNo).Offset(, 4)  実行時エラー アプリケーション定義またはオブジェクトの定義エラー N = N + MyUNo Sheets("決算").Cells(3, 5).Value = N End If End Sub 素人の私には皆目見当がつきません、どうすれば良いのですか。 教えてください、どうかよろしくお願いします。

  • エクセル マクロの設定方法について

    差込印刷でSheet1に作成した名簿データにより、sheet2に作成しているデータへ差込印刷をしています。現在、次のようなマクロを組んで名簿の件数に合わせて、For = 2 To 500 Step 8を修正しながら、印刷しています。できたら、名簿の件数の増減に関係なく印刷できるようになればと考えています。始めたばかりのマクロ初心者です。よろしくご教授ください。お願いします。 Dim i As Long Dim ws1 As Worksheet, ws2 As Worksheet Set ws1 = sheets(″sheet1″) Set ws2 = sheets(″sheet2″) For i = 2 To 500 Step 8 ws2 .Range(″A1″).Value = ws1.Cells(i+1,2).Value ws2 .Range(″A7″).Value = ws1.Cells(i+2,2).Value ws2 .Range(″A13″).Value = ws1.Cells(i+3,2).Value ws2 .Range(″A19″).Value = ws1.Cells(i+4,2).Value ws2 .Range(″F1″).Value = ws1.Cells(i+5,2).Value ws2 .Range(″F7″).Value = ws1.Cells(i+6,2).Value ws2 .Range(″F13″).Value = ws1.Cells(i+7,2).Value ws2 .Range(″F19″).Value = ws1.Cells(i+8,2).Value DoEvents ws2.PrintOut Next End Subws2 .Range(″F1″).Value = ws1.Cells(i+5,2).Value ネット等で調べて、上記のようなマクロで作業してます。(マクロの設定方法が間違っているところがあると思いますが?)

  • 実行時エラー”1004”アプリケーション定義または

    次のようなコードで10の平均と20の平均はエラーにならないのですが75の時のみエラーになります Sheets(SN).Cells(gyou, 22)のセルにはすべて数字があるのですがエラーになります。 エラー”1004”アプリケーション定義またはオブジェクト定義のエラー au = 100 sk1 = 10 sk2 = 20 sk3 = 75 If WorksheetFunction.Sum(Range("V90:V99")) <> 0 Then Sheets(SN).Cells(au, 24).Value = Application.WorksheetFunction.Average(Sheets(SN).Range(Cells(au - (sk1 - 1), 22), _ Sheets(SN).Cells(au, 22))) End If If WorksheetFunction.Sum(Range("V75:V99")) <> 0 Then Sheets(SN).Cells(au, 25).Value = Application.WorksheetFunction.Average(Sheets(SN).Range(Cells(au - (sk2 - 1), 22), _ Sheets(SN).Cells(au, 22))) End If If WorksheetFunction.Sum(Range("V25:V99")) <> 0 Then Sheets(SN).Cells(au, 26).Value = Application.WorksheetFunction.Average(Sheets(SN).Range(Cells(au - (sk3 - 1), 22), _ Sheets(SN).Cells(au, 22))) エラーの原因を教えてくださいよろしくお願いします。

  • エクセルVBAについて

    こんにちわ! 今、エクセルでAシートの入力した項目をBのシートへデーターが入力できるようなシステムを以下のようにくみました。 そこでBシートにデーターが入力されるのですが20行まで入力すると入力できないようにしたいのですが、なかなか上手くいきません。 A1からF20まで書式のロックを外しそれ以外のセルは保護をかけたのですがその状態でVBAを使って20行以上入力できませんという感じのエラー表示をしたいのですが、どうすればいいでしょうか? VBAは初心者ですが宜しくお願いします。 Private Sub CommandButton1_Click() Dim row As Integer row = WorksheetFunction.CountA(Sheets("date").Columns(1)) + 1 Sheets("date").Cells(row, 1).Value = Range("B2").Value row = WorksheetFunction.CountA(Sheets("date").Columns(2)) + 1 Sheets("date").Cells(row, 2).Value = Range("B3").Value row = WorksheetFunction.CountA(Sheets("date").Columns(3)) + 1 Sheets("date").Cells(row, 3).Value = Range("B4").Value row = WorksheetFunction.CountA(Sheets("date").Columns(4)) + 1 Sheets("date").Cells(row, 4).Value = Range("B5").Value row = WorksheetFunction.CountA(Sheets("date").Columns(5)) + 1 Sheets("date").Cells(row, 5).Value = Range("B6").Value row = WorksheetFunction.CountA(Sheets("date").Columns(6)) + 1 Sheets("date").Cells(row, 6).Value = Range("B7").Value Sheets("統制入力").Select Range("B17").Select ActiveWindow.SmallScroll Down:=-9 Range("B3:B7").Select Selection.ClearContents Range("B1").Select End Sub

  • Excel VBAについて

    Excel VBAについて教えて頂きたいのですが、 Sub test() Dim lastrow, r, i As Long Dim sh1, sh2 As String Dim ws As Worksheet lastrow = Cells(Rows.count, "D").End(xlUp).row For r = 7 To lastrow '7 For i = 1 To lastrow '4 sh1 = ActiveSheet.Cells(r, 4) ActiveSheet.Cells(r, 20) = _ Application.CountIfs(Sheets(sh1).Range("D:D"), Range("H3") & Range("I3"), Sheets(sh1).Range("K:K"), "<=3") _ / Application.CountIf(Sheets(sh1).Range("D:D"), Range("H3") & Range("I3")) ActiveSheet.Cells(r, 21) = _ Application.CountIfs(Sheets(sh1).Range("C:C"), Range("F3"), Sheets(sh1).Range("K:K"), "<=3") _ / Application.CountIf(Sheets(sh1).Range("C:C"), Range("F3")) ActiveSheet.Cells(r, 22) = _ Application.CountIfs(Sheets(sh1).Range("E:E"), Range("K3"), Sheets(sh1).Range("K:K"), "<=3") _ / Application.CountIf(Sheets(sh1).Range("E:E"), Range("K3")) Sheets(sh1).Range("A3:R3").AutoFilter Field:=4, Criteria1:=Range("H3") & Range("I3") ActiveSheet.Cells(r, 15) = Application.Subtotal(105, Sheets(sh1).Range("O:O")) Sheets(sh1).Range("A3:R3").AutoFilter Field:=4, Criteria1:=Range("H3") & Range("I3") - 200 ActiveSheet.Cells(r, 18) = Application.Subtotal(105, Sheets(sh1).Range("O:O")) Sheets(sh1).Range("A3:R3").AutoFilter Field:=4, Criteria1:=Range("H3") & Range("I3") + 200 ActiveSheet.Cells(r, 19) = Application.Subtotal(105, Sheets(sh1).Range("O:O")) For Each ws In Worksheets ws.AutoFilterMode = False Next Next Next End Sub このコードは ActiveSheetで実行すると D列の7行目から最終行までに入力されている名前のシート(名前=シートがあります) その、シートの参照先で C,D,E列がcountif関数を利用して O列がSubtotal関数を利用しています。 このコードでもやりやいことは実行できるのですが、 時間がかかりすぎてしまいます。 約20件あり約2分ほどかかります。パソコンによっては倍ほど時間がかかるかもです。 そこでなのですが、 もっと処理のスピードを上げたいのですが、 可能でしょうか? 可能ならそのやり方をご教示ください。 よろしくお願い致します。

  • エクセルのマクロについて

    下記のようなプログラム組んでいます。 Sub 張付() Sheets("一覧表").Select Dim i As Long Dim ws1, ws2 As Worksheet Set ws1 = Worksheets("一覧表") Set ws2 = Worksheets("データー") For i = 5 To ws2.Cells(Rows.Count, 1).End(xlUp).Row ws1.Range("B5") = ws2.Cells(i, 2)    'セルB5に氏名を入力 ws1.Range("C5") = ws2.Cells(i, 3)    'セルC5に年齢を入力 ws1.Range("D5") = ws2.Cells(i, 4)    'セルD5に電話番号を入力 この後、 ws1.Range("B5")のB5をB6にまた、C5はC6に改行してそれぞれデーターを移していきたい のですが、B5をB6に順次プラスする方法を教えて下さい。 よろしくお願いいたします。

  • エクセル マクロ修正

    シート1~5まであります。別に情報シートを作成しています それぞれ同じ原本から作成しています 全部のシートにA1~A10のセルに日付、B1~B10のセルに文字など入力がするところがあります 入力はA1から順番に入れていきます 例えば 保存ボタンを作成しておく シート1のA1に日付、B1に”文字”を入力し、保存ボタンをおす 情報シートに日付と内容が一致する情報がなければ、 情報シートのA列にシート名、B列に日付、C列に入力した内容が 空白のところに出力される ボタンのマクロがCommandButton1_Clickとしたら Private Sub CommandButton1_Click() 検索 End Sub 標準モジュールに Sub 検索() Dim c As Range Dim ws1 As Worksheet Dim ws2 As Worksheet Dim ws1LastRow As Long Dim ws2LastRow As Long Set ws1 = Sheets("情報シート") Set ws2 = ActiveSheet If ws2.Range("A1").Value = "" Or ws2.Range("B1").Value = "" Then MsgBox "検索する日付もしくは語句が入力されていません。", vbCritical Exit Sub End If If ws1.Range("A1").Value = "" Then ws1LastRow = 0 Else ws1LastRow = ws1.Cells(Rows.Count, "A").End(xlUp).Row End If ws2LastRow = ws2.Cells(Rows.Count, "A").End(xlUp).Row For Each c In ws1.Range(ws1.Cells(1, "B"), ws1.Cells(Rows.Count, "B").End(xlUp)) If c.Value2 = ws2.Cells(ws2LastRow, "A").Value2 Then If c.Offset(0, 1).Value = ws2.Cells(ws2LastRow, "B").Value Then MsgBox "既にデータが存在します", vbInformation Exit Sub End If End If Next ws1.Cells(ws1LastRow + 1, "A").Value = ws2.Name ws1.Cells(ws1LastRow + 1, "B").Resize(1, 2).Value = ws2.Cells(ws2LastRow, "A").Resize(1, 2).Value MsgBox "データを追加しました", vbInformation Set ws1 = Nothing Set ws2 = Nothing End Sub これを教えて頂き作っていたのですが 別のシートを作成しこのプログラムを応用していたのですが うまく起動しないため再度投稿しました 今度のやつは固定でやろうと思っていていじったのですが 別の欄の文字が表示してしまった 結合セルB2:C4に日付を入れる 結合セルL2:L30に内容を入れるようにしたいのですが ここだけのセルを参照するようにしたいのです。 どうすればいいでしょうか? 試したことAをB2にかえ、BをL2にしたら変なことになりました・・・

  • エクセルのマクロで結合セルに値を貼り付けたい

    みなさん、お知恵をください。 Excel2000です。 Sheets(1)に A:D までを結合したセルを30行ぐらい用意した状態で Sheets(2)の 単一セル A1,A2,A3,A4,A5・・・・とつづく変数 HENSUUを 貼り付けたいのです。*HENSUUは値のみの文字であったり数字です。 もちろん下記の過去質問はチェック済みです。 http://oshiete1.goo.ne.jp/qa2197173.html 物まねで作成しましたがエラーです。 Sheets(2).Select HENSUU = Range("A65536").End(xlUp).Row  ’変数最終行定義 Sheets(1).Range(Cells(1, 1), Cells(HENSUU, 1)).Value = Sheets(2).Range(Cells(1, 1), Cells(HENSUU, 1)).Value すみません。お知恵を拝借させて下さい。 よろしくお願いします。

  • エクセル マクロ 抽出

    教えてください。 ○と記入されたセルを参照して、一つ上のセル・A列にある同じ行のセル・ 9行目にある同じ列のセルを抽出しようとしています。 下記の通り入力すると 行数=値.Rowでエラーが出たしまいました。 試行錯誤頑張りましたが解決できそうにありませんのでお力を貸して頂けないでしょうか。 Sub 抽出() Dim i, 行数, 列数 As Long Dim 値 As Range i = 0 行数 = 値.Row 列数 = 値.Column For Each 値 In Sheets("sheet1").Range("C12:R171") If 値.Value = "○" Then i = i + 1 With Sheets("sheet2") .Cells(i, 3).Value = Sheets("sheet1").Cells(行数, 1).Value .Cells(i, 4).Value = Sheets("sheet1").Cells(9, 列数).Value .Cells(i, 5).Value = 値.Offset(-1, 0).Value End With End If Next End Sub

  • エクセルマクロ offsetの使い方

    Sub tess() With Worksheets("Sheet1") Cells(1,11)=Application.WorksheetFunction.Max(Range("A1:A10")) End With End Sub 上記でA1~A10のうちの最大値1つがA12に表示されます。 ここで上記コードに手を加えて、例えばA12にA8の”下のセル1つの値”を表示したいのですが、 Cells(1,11)=offset.(-1, 0).Application.WorksheetFunction.Max(Range("A1:A10")) と”offset(-1, 0)” を加えても動きません。WorksheetFunctionを加えても動きません。 offsetを入れる位置と使い方がわかりません。是非よろしくお願いいたします。(OS:WindowsXP、Excel2003)

専門家に質問してみよう