[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『ユーザーフォームを使った複数条件設定からの抽出』（EHO）
いつもお世話になってます。エクセルで元帳を作成中です。一つのブック「仕訳」に一年の仕訳を全て入力し、別のブックに必要なデータだけ抽出したいのですが行き詰まっています。ユーザーフォームを使って期間と科目を指定して、ブック「元帳」に表示させたいのですが。。。ブック「仕訳」は
列 A B C D E F G H I J K L
(空) ｺｰﾄﾞ 年月日 部門 摘要 備考 借方金額 税区分 科目 借方金額 税区分 科目
と項目が並び、1月1日〜12月31日までデータを追加していきます。
ブック「元帳」にユーザーフォームを作成して、例えば7月1日〜7月31日の現金のデータのみ抽出したいのです。ブック「元帳」は
列 A B C D E F G H
ｺｰﾄﾞ 年月日 部門 摘要 備考 借方金額 貸方金額 残高
という感じで作っています。とりあえずは資産科目だけでもなんとかしたいのですが、どなたか教えてもらえませんか。
以前似たようなことをしたような。 オートフィルタ抽出＞指定範囲へ貼り付けのような感じなら これの↓応用でいけると思いますが、 [[20050415103520]]『マクロについて』（まりお） わたしが請け負うと時間がかかりマス。 日付や科目名の指定はどのようにされる予定ですか？ テキストボックスでの入力や、リストボックス、コンボボックスからの 選択など、いろいろ考えられますので、配置するコントロールとその役割を 大雑把にでも教えてください。（みやほりん）
期間は、
H17.1.1〜1.31
H17.2.1〜2.28
といった具合にコンボボックスから選択できるようにしたいです。
科目も、
基本的には同様に科目表から選択できるのがいいのですが、数が多いので手入力してもエラーがでないようにできれば、最高です。
時間がかかっても結構ですのでお願いします〜！私も勉強しながらチャレンジします。
（EHO）
> 時間がかかっても結構ですのでお願いします ほならとりあえず現金（私の大好きな）からいきまひょか・・・（笑 ざっとですけどユーザーフォームにコンボ２個、コマンドボタン２個作ってくらはい。 仕訳のファイルと元帳のファイルも作成しておくんなはれ。 当然の事ながら資産の部と負債の部の扱いは違いますけど、根本的には計算方法が 違うだけでのことであって、マクロに組み込むにはさして難しい事はおまへん。 まぁ、試してみておくんなはれ。 あんさんのご希望通りに結果がでたら、それでもうこのマクロはでけたみたいなもん ですわ、えぇ。あとはそれを応用していくだけですからなぁ。 但し元帳のH2には残高を書いとってくだはいよ。 わても忙しい（弥太郎）
ここのコード消去
あらーっ、立派なコードができあがっとるがな。
こちとら、日付をコンボボックスのコード一つで手一杯っちゅうに。
とりあえず出すもんはだしとこう。
下記はユーザーフォーム呼び出し時に日付期間を表示するコンボボックスへ
日付期間をセットするコード部分（だけ）。
「H17」以外も対応。
弥太郎さんのコードにあわせてCombobox2としました。
現状ではWorkbooks("元帳.xls").Worksheets("Sheet1").Range("C2")
に必ず日付（シリアル値）が入力されていることを前提としています。
それを元に日付期間をセット。
Private Sub UserForm_Initialize()
Dim MyYear As Long, i As Long
Dim FstDate As String, LstDate As String
MyYear = Year(Workbooks("元帳.xls").Worksheets("Sheet1").Range("C2").Value)
For i = 1 To 12
FstDate = Format(MyYear & "/" & i & "/1", "ge.m.d")
LstDate = Format(DateValue(MyYear + Abs(CLng(i = 12)) & "/" & i * Abs(CLng(i <> 12)) + 1 & "/1") - 1, "ge.m.d")
Me.ComboBox2.AddItem FstDate & " 〜 " & LstDate
Next i
End Sub
（みやほりん）
ひゃ〜っ！すごい！お二人とも忙しい中、ありがとうございます！さっそくやってみます。
（EHO）
すみません。。。非常に恐縮ですが、ユーザーフォームの表示方法が分かりません（*＾＾*;）ダブルクリックしたら表示されるというのしか使ったことがないもので・・・基本的過ぎて申し訳ないです。それとできれば常に表示させておきたいのですが・・・どなたか助けて下さい（．．）（EHO）
コントロールツールボックスのコマンドボタンクリックでユーザーフォーム表示の例。 表示＞ツールバー＞コントロールツールボックス ツールバーからコマンドボタン選択、ボタンをシート上の任意の位置へ作成。 コマンドボタン右クリック、「コードの表示」選択、 Private Sub CommandButton1_Click()
End Sub というコードが自動的に（シートモジュールへ）作成されるので、 Private Sub CommandButton1_Click() UserForm1.Show 0 End Sub と書き加えます。（UserForm1というユーザーフォームの場合。） 引数 0 はモードレス（フォーム表示中もブック編集が可能）な表示。 ブックオープン時に自動表示するにはブックモジュールで Private Sub Workbook_Open() UserForm1.Show 0 End Sub とするか、標準モジュールで Sub Auto_Open() UserForm1.Show 0 End Sub のいずれか。 「常に表示させておきたい」は「閉じる」ボタンを無効にしたいということ？ 「閉じる」ボタンでいつでも閉じることができてしまいますからね。 【追記】 「閉じる（×）」ボタンの無効化はこちらで議論したことが。 [[20050422225958]] 『ユーザーフォームの右上の×ボタンを表示しない』(G) （みやほりん）
作成者のこてこてナニワ弁のおっちゃんが再登場してくれると ありがたいのですが、エラーメッセージがでて「デバッグ」ボタンを押したときに ハイライト表示される行はどこでしょうか。 （ちなみに私は繁忙期のためただいまより8月16日までカキコ制限に入ります） （みやほりん）
With Workbooks("仕訳.xls")
With .Worksheets("sheet1")
d_f = Split(kikan, "to")
data_strt = d_f(0)
data_end = d_f(1)
For i = 2 To .Range("b65536").End(xlUp).Row
If .Cells(i, 3) >= data_strt And .Cells(i, 3) <= data_end Then
ReDim Preserve cdt(n)
ReDim Preserve rsz_cnt(n)
ReDim Preserve dbt(n)
If .Cells(i, 9) = kamoku Then
rsz_cnt(n) = 6
cdt(n) = .Cells(i, 2).Resize(, rsz_cnt(n)).Value
n = n + 1
ElseIf .Cells(i, 12) = kamoku Then
rsz_cnt(n) = 5
cdt(n) = .Cells(i, 2).Resize(, rsz_cnt(n)).Value
dbt(n) = .Cells(i, 10)
n = n + 1
End If
の最初の行1行が黄色になってます。
みなさんこの時期忙しいと思いますが、どなたか分かる方お願いします。
（EHO）
上のエラーの件ですけど、ファイル仕訳は開いてまっか？ またSheet1ではなくて違うシート名を使うとるんやおまへんか？ （弥太郎）
シートの名前は変更してましたが、ファイル仕訳を開いてませんでした。開いて実行すると今度は、data_strt = d_f(0) が黄色くなったのですが・・・すみません。お手数かけます。
（EHO）
暫くエラーとの闘いでんなぁ。（笑 'ユーザーフォームのモジュールへ Option Explicit Dim kikan Dim kamoku As String は最上行へ（General Declarations)へコピペでけてまっか？
また
Private Sub ComboBox2_Change()
Select Case ComboBox2.ListIndex
Case 0
kikan = "×"
以下はちゃんと最後までコピペでけてまっか？
再確認してくらはい。
（弥太郎）
コピペ？？？ すみません。分かりません（；；）
コピーペースト、コピーしたコードを所定の場所へ貼り付けする事を指します。 （弥太郎）
「 Option Explicit
Dim kikan
Dim kamoku As String
は最上行へ（General Declarations)へコピペ」 はできました。
「 Private Sub ComboBox2_Change()
Select Case ComboBox2.ListIndex
Case 0
kikan = "×"
以下はちゃんと最後までコピペ」 というのは、1月分から12月分まで期間が入ってるかということでしょうか？それならできています。
そこで再度科目を選択してボタン1を押すと、
"選択が間違っとります。やり直してくらはい。"が出てきました。
少しずつ進んではきてるような・・・。あとどこを見ていったらよろしいんでしょう？
ほんとにお忙しいところすみません。
（EHO）
あら？おかしいなぁ。昨日新しいコードをカキコしてまへんでした？ ？？？
いいええな、前回のんは資産の部しか残高計算でけまへんでしたから、負債の部も 残高計算でけるように作ったヤツですワ。 面倒でっしゃろけど、このコードに差し替えてもらわれしまへんか。 inp_dataには財務諸表に則って書き込んでくらはい。 ’マークの所はi>○を変更しておくんなはれ。 紛らわしくなるんで前のコードは消しときまっせぇ。 （弥太郎） メッセージボックスがでる？んは、勘定科目を選択、且つ拾い出し期間が選択されて なければメッセージで間違いを指摘するようになっとります。 '----------------------- Option Explicit Dim flag As Boolean Dim kikan Dim kamoku As String
Private Sub ComboBox1_Change()
Dim i As Integer
For i = 0 To UBound(inp_data)
Select Case ComboBox1.ListIndex
Case i
kamoku = inp_data(i)
Exit For
End Select
Next i
If i > 5 Then 'ここはinp_dataの科目を０と計算して財務諸表の資産の分の
'最後（サンプルでは貸付金の番目を使っている）の数値を入れる
flag = True
Else
flag = False
End If
End Sub
'-----------------------------------
Private Sub ComboBox2_Change()
Select Case ComboBox2.ListIndex
Case 0
kikan = "×"
Case 1
kikan = "1/1to1/31"
Case 2
kikan = "2/1to2/28"
Case 3
kikan = "3/1to3/31"
Case 4
kikan = "4/1to4/30"
Case 5
kikan = "5/1to5/31"
Case 6
kikan = "6/1to6/31"
Case 7
kikan = "7/1to7/31"
Case 8
kikan = "8/1to8/31"
Case 9
kikan = "9/1to9/31"
Case 10
kikan = "10/1to10/31"
Case 11
kikan = "11/1to11/30"
Case 12
kikan = "12/1to12/31"
End Select
End Sub
'-------------------------------
Private Sub CommandButton1_Click()
Dim n As Integer
Dim i As Long, maxrow As Long
Dim data_strt As Date, data_end As Date
Dim rsz_cnt(), dbt(), d_f, cdt()
If kamoku = "科目" Or kikan = "×" Then
MsgBox "選択が間違っとります。やり直してくらはい。!", vbExclamation
If kamoku = "科目" Then
ComboBox1.SetFocus
Else
ComboBox2.SetFocus
End If
Exit Sub
End If
With Workbooks("仕訳.xls")
With .Worksheets("sheet1")
d_f = Split(kikan, "to")
data_strt = d_f(0)
data_end = d_f(1)
For i = 2 To .Range("b65536").End(xlUp).Row
If .Cells(i, 3) >= data_strt And .Cells(i, 3) <= data_end Then
ReDim Preserve cdt(n)
ReDim Preserve rsz_cnt(n)
ReDim Preserve dbt(n)
If .Cells(i, 9) = kamoku Then
rsz_cnt(n) = 6
cdt(n) = .Cells(i, 2).Resize(, rsz_cnt(n)).Value
n = n + 1
ElseIf .Cells(i, 12) = kamoku Then
rsz_cnt(n) = 5
cdt(n) = .Cells(i, 2).Resize(, rsz_cnt(n)).Value
dbt(n) = .Cells(i, 10)
n = n + 1
End If
End If
Next i
End With
End With
Workbooks("元帳.xls").Worksheets("sheet1").Activate
maxrow = Range("h65536").End(xlUp).Row + 1
For i = 0 To n - 1
Cells(i + maxrow, 1).Resize(, rsz_cnt(i)).Value = cdt(i)
Cells(i + maxrow, 7) = dbt(i)
If rsz_cnt(i) = 6 Then
If flag Then
Cells(i + maxrow, 8) = Cells(i + maxrow - 1, 8) - Cells(i + maxrow, 6)
Else
Cells(i + maxrow, 8) = Cells(i + maxrow - 1, 8) + Cells(i + maxrow, 6)
End If
Else
If flag Then
Cells(i + maxrow, 8) = Cells(i + maxrow - 1, 8) + Cells(i + maxrow, 7)
Else
Cells(i + maxrow, 8) = Cells(i + maxrow - 1, 8) - Cells(i + maxrow, 7)
End If
End If
Next i
End Sub
'-------------------------------------
Private Sub CommandButton2_Click()
Unload Me
End Sub
'----------------------------------
Private Sub UserForm_Initialize()
Dim i As Integer
flag = False
With ComboBox1
For i = 0 To UBound(inp_data)
.AddItem inp_data(i)
Next i
.Text = .List(0)
End With
With ComboBox2
.AddItem "拾い出し期間"
For i = 1 To 12
Select Case i
Case 1, 3, 5, 7, 8, 10, 12
.AddItem "H17." & i & ".1〜" & i & ".31"
Case 2
.AddItem "H17." & i & ".1〜" & i & ".28"
Case Else
.AddItem "H17." & i & ".1〜" & i & ".30"
End Select
Next i
.Text = .List(0)
End With
End Sub
'-----------------------------
Public Function inp_data() As Variant
inp_data = Array("科目", "現金", "普通預金", "当座預金", "売掛金", "貸付金", "借入金", "買掛金")’このかっこ内に追加して下さい。
End Function
お返事遅くなりました（．．）
見捨てないでくれて本当にありがとうございます！
教えていただいた通り、前のは削除して入れ直しました。資産項目の数は22だったので
Next i
If i > 22 Then
として科目名もかっこの中に入力しました。
シート名も変更し、二つのファイルを開けて、科目・期間を選択しボタン1を押したところ、
「型が一致しません」と出て
Cells(i + maxrow, 8) = Cells(i + maxrow - 1, 8) - Cells(i + maxrow, 7)
が黄色くなりました。
あと何をすればよいでしょう？
（EHO）
それは元帳のH2に残高を記入してないからですワ、多分。
とりあえず残高を記入して試して下さい。
（弥太郎）
で、できた〜！ありがとうございます〜！すばらしい！ものすごく助かりました（；ｏ；）
（EHO）
CommandButton1のコードで
Workbooks("元帳.xls").Worksheets("sheet1").Activate
maxrow = Range("h65536").End(xlUp).Row + 1
の下に↓を付け加えると作業中の勘定科目と拾い出し期間が表示されますワ。
Cells(2, 1) = kamoku 'この行追加
Cells(2, 2) = ComboBox2.Value 'この行追加
問題は先月残をどこからどうやって引っ張ってくるかでんなぁ。（笑
（弥太郎）
お返事遅くなりました！またまたありがとうございます。
科目と期間表示されました！すみません、できれば最上行に1行挿入してこれらを表示させたいのですが、このまま挿入して
Cells（1,1）とCells（1,4）
とするだけじゃだめですよね？
あとはどこを触ればよろしいでしょうか？
先月残のことはずっと悩んでるんですが、残高推移表みたいなのを作って引っ張ってくるしか思いつかないのですが。。。 （EHO）
え〜っ、これってまだ続いてまんのんかぁ？ てっきり終止符が打たれとるもんやと思うとりましたんやけど・・・（笑
>Cells（1,1）とCells（1,4） とするだけじゃだめですよね？ 一番手っ取り早い方法はそれを書いて試してみることですワ。 挿入とは？ コマンドボタン押した時点で１行目を挿入するっちゅうことでっか？ それやと挿入した行はどないしまんねん？コマンドボタンをクリックするたびに新しい 挿入されまっせ。 多分２行目に項目をもってきた元帳に転記する事を意味すると思うんですけど、 Ｈ３に残高を書いて上の>Cells・・・を書いたマクロを実行してみると良くお分かりに なるんとちゃいまっか。
>先月残のことはずっと悩んでるんですが そのお仕事はあんさんのお仕事です。ねじりハチマキしてでもマクロでやっつけてやろ うというやる気が起こるまで面倒でも手入力に頼ってくらはい。（笑 それともやっぱし楽したいと思うたら、別スレ立てるっちゅんも選択肢のひとつですけ どなぁ。 なぁに、心配しなはんな。ちゃんとした質問状ならキチンと回答してくれますワ、ええ （弥太郎）
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.