2018年3月3日土曜日

ブックの全シートをまとめるコード

こんにちは、Shigeです。
今回は、ブックに複数あるシートのデータを「まとめ」のシートにコピペするコードです。

  1. Sub Matome()
  2.   Dim i As Integer
  3.   Dim lRow As Long, lCol As Long, lRow2 As Long
  4.     Application.ScreenUpdating = False
  5.      '----全データシートの有無をチェックします
  6.     call sh_check
  7.     '----列見出しをコピーします
  8.     Worksheets(2).Range("1:1").Copy Worksheets(1).Range("A2")
  9.     For i = 2 To Worksheets.Count
  10.         With Worksheets(i)
  11.             lRow = .Cells(Rows.Count, 1).End(xlUp).Row
  12.             lCol = .Cells(1, Columns.Count).End(xlToLeft).Column
  13.             '----シートのデータが2行以上の場合にコピーします
  14.             If lRow >= 2 Then
  15.                 lRow2 = Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1
  16.                 .Activate
  17.                 .Range(Cells(2, 1), Cells(lRow, lCol)).Copy Worksheets(1).Cells(lRow2, 1)
  18.             End If
  19.         End With
  20.     Next i
  21.     Worksheets(1).Activate
  22.     Application.ScreenUpdating = True
  23. End Sub
4行目と28行目のApplication.ScreenUpdatingはコピーするワークシートをアクティブにしてるので、処理を早くするために画面の表示を止めてるコードですね。他のでもよく使ってますので、前にも書いたかもしれませんね(;・∀・)

6行目で「まとめ」シートがブック内にあるかどうかをチェックしてます。(他のマクロで)
8行目はまとめる前のシートに見出しがある場合を想定してるので、必要なければ消してください。
10~20行目はsh_checkで「まとめ」シートを先頭のワークシートにしているので、ワークシートの2枚目から最後まで、ワークシートの行が2行以上の場合に「まとめ」シートにコピーをすることを繰り返します。
最後に「まとめ」シートのWorksheets(1)をアクティブにして完了ですね。
だいぶ前に作成したものなので、わざわざコピペするためにアクティブにしてたりしてますが、何十枚もシートがなければそんなに時間はかからないはずですのでこのままのっけました。
では、また。

2018年2月28日水曜日

特定のシートからCSVを作成するコード(その2)

こんにちは、Shigeです。
今回は、前回の特定のシートからCSVを作成するコード内のcsvシートがあるかどうかをチェックするマクロ「Sh_check_csv」をのっけます。

  1. Sub Sh_check_csv()
  2.     Dim ws As Worksheet, Flag As Boolean
  3.     Dim newSh As String
  4.     
  5.     newSh = "csv"
  6.     
  7.     For Each ws In Worksheets
  8.         If ws.Name = "csv" Then Flag = True 'csvシートがある場合、変数flagをTrueにする
  9.     Next ws
  10. '-------------------------------------------------
  11.     If Flag = False Then
  12.     ActiveWorkbook.Worksheets.Add(after:=Worksheets(Sheets.Count)).Name = newSh
  13.     End If
  14. '変数flagがFalseのままだったらcsvシートを追加する
  15. '------------------------------------------------
  16.     Worksheets(newSh).Unprotect    ' 一旦、シート保護を解除
  17.     Worksheets(newSh).Visible = True
  18.     Worksheets(newSh).Columns("A:A").NumberFormatLocal = "yyyy/m/d;@"
  19. End Sub
そんな難しいこともないと思うので、今回も流れだけ(;・∀・)

「csv」って名前のシートを全部のシート名を検索して、あったらFlagをTrueにしてFalseのままだったらワークシートの一番最後にcsvシートを追加(15行目コメントまで)→シート保護をかけてるので解除してからA列の書式を"yyyy/m/d;@"形式にする。

どうですか?VBAをかじってれば読めるコードだと思います。
では、また。

2018年2月26日月曜日

特定のシートからCSVを作成するコード

こんにちは、Shigeです。
今回は特定のシートからcsv形式でエクスポートするコードをのっけます。

  1. Sub CSVmake()
  2. Dim FileN As String, strfind As String, newBook As String, ThisUser As String, PathName As String
  3. Dim Re As Long, loCheck As Long
  4. Dim FSO As Object
  5. Set FSO = CreateObject("Scripting.FileSystemObject")

  6. Set shKihon = Worksheets("基本情報")
  7. Set ShAc = ActiveSheet
  8. 'csvシートがあるかチェック 無ければ作成
  9. Call Sh_check_csv
  10. Set Shcsv = Worksheets("csv")
  11. '---------------------
  12. Shcsv.Cells.ClearContents   'csvシートのデータクリア

  13. Call CSVchange(loCheck)

  14. newBook = shKihon.Cells(1, 2).Value

  15. If Dir("C:\csv_date", vbDirectory) = "" Then FSO.CreateFolder "C:\csv_date"
  16. PathName = "C:\csv_date"
  17. ChDir (PathName)
  18.    
  19. FileN = Application.GetSaveAsFilename(InitialFileName:=newBook, _
  20.                            filefilter:="CSV ファイル (*.csv), *.csv")
  21. If FileN <> "False" Then
  22.     If Dir(FileN) <> "" Then
  23.         Re = MsgBox(FileN & String(2, vbLf) & _
  24.                           "は、存在します。 上書きしますか?", vbYesNo)
  25.         If Re = vbYes Then Kill FileN Else Exit Sub
  26.     End If
  27.     Shcsv.Copy
  28.     ActiveWorkbook.SaveAs Filename:=FileN, FileFormat:=xlCSV
  29.     ActiveWorkbook.Close Savechanges:=False
  30.     Shcsv.Visible = False
  31.     If loCheck = 0 Then
  32.         MsgBox "CSVファイルで書き出しました。", vbInformation
  33.     Else
  34.         MsgBox "CSVファイルで書き出しました。" & _
  35.             vbCrLf & loCheck & "件、仕訳が訂正されています。", vbInformation
  36.     End If
  37. End If
  38. Set FSO = Nothing
  39. ' シート保護を設定(UIのみ)
  40. ActiveSheet.Protect UserInterfaceOnly:=True
  41. End Sub
長いうえに他のコードを走らせてる部分があるので、全部解説するのが面倒だからコード書くだけにしようかな。
前回の「弥生会計形式でエクスポートするコード」と合わせると出来上がってくると思います。
まぁ、流れだけでも書き捨てしておきます。

csv用シートがあるかチェック→出納帳のデータ部分をcsv用シートに書出し+訂正仕訳があるかチェック(loCheck)→Cドライブ直下にフォルダを追加してそこにcsvを作成→確認メッセージ

とりあえず、一つ一つはそれほどのことでもないけど、組み合わせると全部解説するのは長文になりそうですね(;・∀・)
コードをまとめ終わったら、そこら辺も詳しくしていけたらと思ってます。
では、また。

2018年2月24日土曜日

弥生会計インポート形式でエクスポートするコード

こんにちは、Shigeです。
今回はコードの一部分だけのっけます。


  1.     Shcsv.Cells(w, 1).Value = 2000
  2.     Shcsv.Cells(w, 4).Value = ShAc.Cells(i, 1).Value '日付
  3.     Shcsv.Cells(w, 17).Value = ShAc.Cells(i, 7).Text '摘要
  4.     Shcsv.Cells(w, 8).Value = "対象外" '借方税区分
  5.     Shcsv.Cells(w, 14).Value = "対象外" '貸方税区分
  6.     Shcsv.Cells(w, 10).Value = 0 '借方消費税金額
  7.     Shcsv.Cells(w, 16).Value = 0 '貸方消費税金額
  8.     Shcsv.Cells(w, 20).Value = 0 'タイプ
  9.     Shcsv.Cells(w, 25).Value = "no" '調整
  10.     Shcsv.Cells(w, 5).Value = ShAc.Cells(i, 2).Value '借方科目
  11.     Shcsv.Cells(w, 6).Value = ShAc.Cells(i, 3).Value '借方補助科目
  12.     Shcsv.Cells(w, 11).Value = ShAc.Cells(i, 4).Value '貸方科目
  13.     Shcsv.Cells(w, 12).Value = ShAc.Cells(i, 5).Value '貸方補助科目
  14.     Shcsv.Cells(w, 9).Value = ShAc.Cells(i, 6).Value '金額
  15.     Shcsv.Cells(w, 15).Value = ShAc.Cells(i, 6).Value '金額


変数のShcsvはエクスポート用にシートを作成してるので、そのシートを入れてます。
細かく解説するってほどのものでもないですけど「=」の左側が弥生会計のインポート形式に書き出し、右側がインポートしたいデータが入力されているシートのセルを指定しているというコードになります。
ちなみに変数wはcsv側の行列で、変数iはデータ側の行列をforで回してます。
  1. w=1
  2. for i = 5 to MaxRow
  3. ~
  4. w= w+1
  5. next i
みたいな感じですね。
あと、このコードには欠点があります。
免税なら問題ないのですけど、課税事業者の場合は消費税コードを赤文字の部分で強制的に指定しているためインポートをした後に訂正しなければいけないです。
まぁ、どうしてもインポートする時に必要なら、データ側のシートで「税区分」「消費税金額」列でも作成してもらって、「対象外」とか「0」をShAc.Cells(i,〇).valueとかで訂正するとできると思います。
では、また。

2018年2月21日水曜日

選択範囲の空白行を埋めるコード

こんにちは、Shigeです。
今回は自分で選択した範囲に空白行がある場合、空白行の上のセルの値を入れるコードです。
お客様が入力している出納帳で日付部分が同じ日の場合、空白にしている事が多々あるので、それを自動的に埋めるために作成したコードです。
  1. Sub Fill()
  2. Dim SetArea As Range, sel As Range
  3. On Error Resume Next
  4.     Set SetArea = Application.InputBox("空白を埋める範囲を選択してください", _
  5.                                         "範囲選択", Type:=8)
  6.     If SetArea Is Nothing Then Exit Sub
  7.     
  8.     For Each sel In SetArea
  9.         If IsEmpty(sel) Then sel.Value = sel.Offset(-1, 0)
  10.     Next sel
  11. End Sub
これで範囲を選択すると空白が埋まります。
                    3行目 On Error Resume Next エラーを無視するコード。
                    4行目でインプットボックスを表示して範囲を選択しているのですが、その時に何も選択しない時やキャンセルした場合にこの部分で処理が止まってしまうため、エラーを無視するというコードを入れています。
                    条件分岐させればこれを入れなくても済みますが、6行目でマクロ自体を閉じてしまうため、1行だけ書けば済むOn Errorを使ってます。

                    8~10行目 選択した範囲内をFor Eachで回して、空白だった場合には上のセルの値を設定してます。
                    数式をコピーしたい場合は.Valueを.FomulaR1C1に変更すればいける...はず!

                    では、また。

                    2018年2月17日土曜日

                    CSVファイルを選択してコピペする

                    こんにちは、Shigeです。
                    今回はエクセルを選択してブックに取り込むコードをのっけます。
                    1. Sub BookOpen()
                    2. Dim fname As String, Thisbook As String
                    3. Dim ws As Worksheet
                    4. Dim SetArea As Range

                    5. Thisbook = ThisWorkbook.Name '現在のブックの名前を格納
                    6.     Worksheets("TOP").Cells.ClearContents
                    7.     fname = Application.GetOpenFilename(Title:="帳簿を選択")
                    8.     If fname <> "False" Then
                    9.         Workbooks.Open Filename:=fname
                    10.     Else
                    11.         MsgBox " キャンセルしました"
                    12.         Exit Sub
                    13.     End If

                    14. Newbook = ActiveWorkbook.Name  '選択したブックの名前を格納
                    15.     On Error Resume Next
                    16.     Set SetArea = Range("A:J")

                    17.     SetArea.Copy
                    18.     
                    19.     Workbooks(Thisbook).Activate
                    20.     Worksheets("TOP").Cells(1, 1).PasteSpecial
                    21.        
                    22.     Application.DisplayAlerts = False
                    23.         Workbooks(Newbook).Close
                    24.     Application.DisplayAlerts = True
                    25.         
                    26.     MsgBox "コピーしたのでCSVを作成してください"
                    27. End Sub
                    では、ざっくり説明していきます。
                    まず、必要なシートは「TOP」というシートです。こちらは名前を「Date」とか「データ」とかシートを作成してもらえば、「TOP」の部分を変更すれば動きます。
                    7行目 Worksheets("TOP").Cells.ClearContents 「TOP」シートのデータをクリアする
                    説明としては上の「クリアする」で十分だと思うのですが、なんで消すのかというと基本的にこのコードを使う時には「取込したいエクセル」っていうのが決まっていて、それ以外のデータは入っていてほしくない為、最初にデータを消しています。
                    8~14行目は取込したいエクセルを選ばせるダイアログを表示させます。
                    16行目 Newbook = ActiveWorkbook.Name  '選択したブックの名前を格納
                    6行目を飛ばしましたが、なんでブックの名前を格納しているのかは、エクセルのブックを新規に開くとその開いたエクセルがアクティブ(選択した状態)になる為、貼り付けたいエクセルに戻るためには、戻りたいエクセルの名前を格納しておくとWorkbooks(〇〇).Activateでどちらのブックも選択することができます。
                    18行目 Set SetArea = Range("A:J") コピーしたい列を格納(Range型)
                    23行目 Worksheets("TOP").Cells(1, 1).PasteSpecial TOPシートに貼付
                    26行目 Workbooks(Newbook).Close 選択したエクセルを閉じる

                    とりあえず赤文字のところを変更すれば理屈は抜きに使用できると思います。
                    もちろん、この単体のコードだけではコピペするのみですので、「その先」に行くためには独自のコードが必要になりますが、コンバーターを作成する上での導入部分はこちらでいいんじゃないでしょうか。
                    では、また。

                    2018年2月14日水曜日

                    よく使う変数

                    こんにちは、Shigeです。
                    前回コードをアップして思ったのが、いきなりコードだけあっても最終行取得の変数とか、アクティブシートを入れとく変数とかよく使っているものがあるので、今回はそれをまとめとこうと思います。
                    • MaxRow→Long(数値型) Cells(Rows.Count, 1).End(xlUp).Row
                    Rows.Countで「最終行」、その後の1(A列)が最終行を調べる対象の「列」を指定しています。なので1の部分を変えれば調べたい列の最終行がMaxRowに格納されます。
                    ちなみに、空白行があっても一番下の行を調べられるので、調べたい列が変わらない場合にはこの方法で十分だと思ってます。
                    • sh~→Worksheet型  例:Set ShAc=ActiveSheet , Set ShCsv =Worksheets("csv")
                    Worksheet型の変数を格納するには"Set"を使わないといけないです。アクティブなシートだったら”ActiveSheet”と指定すればOKなので簡単ですね。


                    よく使うと言いながらざっと見これだけしかないという残念な感じですが、これからアップしていく中できっと?このページに追加していく変数があるはず!と思う。多分...。

                    今回は詳細なコードをのっけているわけではないのですが、ほぼ毎回出てくると思うので次回からここに挙げたものについては、説明したりしないつもりです。
                    では、また。

                    ブックの全シートをまとめるコード

                    こんにちは、Shigeです。 今回は、ブックに複数あるシートのデータを「まとめ」のシートにコピペするコードです。 Sub Matome()   Dim i As Integer   Dim lRow As Long, lCol As Long, lRow2 As Lo...