- ベストアンサー
ＶＢＡ初心者の労務管理者向けの質問
jcctairaの回答
mont___blancさん こんにちは。 最初の表と2番目の表の違いや意味が理解できていませんが、 とりあえずプログラムをシンプル（処理スピードを考えない等）に作成しました。 Sub 休業日数計算() Dim I As Long Dim J As Long Dim K As Long Range("G2:I6000").ClearContents For I = 2 To 6000 For J = 1 To 5 Step 2 For K = 7 To 9 If Cells(I, J) = Cells(1, K) Then Cells(I, K) = Cells(I, K) + Cells(I, J + 1) Exit For End If Next K Next J Next I End Sub
関連するQ&A
- EXCEL VBAマクロについて質問です
Excel VBAマクロについて質問です ※Excel Ver.は2005でやってます 例のような感じで、 同じ列（列１）に或る同じ列名の数字（列２）を足して 違うセル、または違うブックの指定行に合計値を横並び表示させたいのですがうまくいきません 例のように 同じ言葉が含まれているもの（りんご・青りんご）は足して出したいと思ってます 【理想】実行前 ****************************** 番号 名前 個数 001 りんご 1 002 ばなな 2 003 いちご 3 001 青りんご 2 ****************************** 【理想】実行後 ****************************** 番号 りんご ばなな いちご 001 3 - - 002 - 2 - 003 - - 3 ****************************** ※「-」記号はついてなくても大丈夫です 現在、組んでいるコード・実行結果をのせておきました どなたか享受ください、お願いいたします j = 1 For i = 0 To Range("A65536").End(xlUp).Row cnt = cnt + Range("列２" & i).Value If Range("C" & i + 1).value <> Range("C" & i).value Then 'もし次の行が違う名 Range("任意セル" & j).Value = Range("A" & i).Value '列１ Range("任意セル" & j).Value = Range("B" & i).Value '列２ Range("任意セル" & j).Value = cnt '数字合計 j = j + 1 '出力行カウントアップ cnt = 0 End If Next
- 締切済み
- その他（プログラミング・開発）
- 指定セルへ転記するマクロで値が無い場合固定値転記
シート２の1行目の指定したセルの値をシート１の指定セルに 転記を行いシート１が印刷。 印刷後はシート２の2行目の指定したセルの値をシート１の指定したセルに 転記してシート１が印刷。 シート２にデータが無くなったら停止という以下のマクロにて シート２のＯ列はシート１のセルA19に順次転記なのですが Ｏ列は運用上空白が有る場合が判明した為 値がある場合はその値を転記、値が無い場合は半角で ZZZ と 転記をしたいのですがどこを変更していいのか分かりません。 よろしくお願いします。 Sub データ転記() Dim myRng(1 To 23) Dim cpRng Dim i As Integer Dim n As String, myStr As String With Sheets("Sheet2") Set myRng(1) = .Range("B2") Set myRng(2) = .Range("C2") Set myRng(3) = .Range("D2") Set myRng(4) = .Range("D2") Set myRng(5) = .Range("D2") Set myRng(6) = .Range("E2") Set myRng(7) = .Range("E2") Set myRng(8) = .Range("F2") Set myRng(9) = .Range("F2") Set myRng(10) = .Range("H2") Set myRng(11) = .Range("J2") Set myRng(12) = .Range("K2") Set myRng(13) = .Range("K2") Set myRng(14) = .Range("L2") Set myRng(15) = .Range("M2") Set myRng(16) = .Range("N2") Set myRng(17) = .Range("O2") Set myRng(18) = .Range("P2") Set myRng(19) = .Range("Q2") Set myRng(20) = .Range("R2") Set myRng(21) = .Range("S2") Set myRng(22) = .Range("U2") Set myRng(23) = .Range("G2") End With cpRng = Split("B10,O4,G3,F10,F13,G10,G13,H10,H13,O3,L10,M10,M13,O5,E19,F19,A19,O6,D21,B6,I19,J19,G5", ",") '転記先配列化 With Sheets("Sheet1") .Range("B10,G3,F10,F13,G10,G13,L10,E19,F19,J19,O7,O8,C19,D10,D13,A19,O4,O5").NumberFormatLocal = "@" Do While myRng(1) <> "" For i = 1 To 23 .Range(cpRng(i - 1)).Value = myRng(i).Value Next .Range("C3,C13").Value = Left(.Range("O3").Value, 10) .Range("C10").Value = Mid(.Range("O3"), 11, 6) .Range("O7").Value = Format(Range("O6").Value, "0000000") .Range("O8").Value = Format(Range("J19").Value, "0000000") Call 加工01 Call 加工02 '印刷 .PrintOut For i = 1 To 23 Set myRng(i) = myRng(i).Offset(1) Next i Loop .Range("B10,O4,G3,F10,F13,G10,G13,H10,H13,O3,L10,M10,M13,O5,E19,F19,A19,O6,D21,B6,I19,J19,C3,C10,C13,C19,D10,D13,O8,O7,G5").ClearContents End With For i = 1 To 23 Set myRng(i) = Nothing Next MsgBox "印刷終了" Sheets("Sheet2").Select Cells.Select Selection.Delete Shift:=xlUp Sheets("Sheet1").Select Range("C3").Select End Sub
- ベストアンサー
- オフィス系ソフト
- このVBAコードの解説をお願いします。
特定の行の中で同じものが続いたらセルを結合する、ということがやりたくて 以下のコードをネット上から探してきました。 上記の動作は実現できたのですが、自分でこのコードをみてもイマイチわかりません。 お分かりになる方、できれば1行ずつ解説してください。 よろしくお願いします。 Sub Sample() Dim myRng As Range, myRow As Long Set myRng = Range("A1") For myRow = 1 To Cells(Rows.Count, 1).End(xlUp).Row With Cells(myRow, 1) If .Value = .Offset(1).Value Then Set myRng = Union(myRng, .Offset(1)) Else Application.DisplayAlerts = False myRng.Merge Application.DisplayAlerts = True Set myRng = .Offset(1) End If End With Next End Sub
- 締切済み
- オフィス系ソフト
- Excel のVBAに付いて教えて下さい。
前回、質問しました内容が関連してくるんですが 参考に下記のURLを ご覧になって下さい。 http://okwave.jp/qa/q7472816.html 前回の内容ですと、指定した列を月で指定してComboboxで選択していました。 その指定した列に特定の文字数を入力すると言う動作を作成しました。 特定の文字数を入力すると言う内容ですが、現時点では指定した列に上から下に 順序に入力して行くように作成してます。 そのコードが”Set myRng = Range(rng).End(xlUp).Offset(1)”です。 今回は、Comboboxで指定した列の2つ隣の列に日付が入力されています。 2つ隣と言うのは、左に向かって2つ隣です。 例えばC列を指定したとすればA列を表します。 実際に行いたいことは、指定した列の日付の入った行を検索し、指定した日付の所に 文字数を入力したいと考えています。 Userformを使って入力しているんですが、Combobox1が月の列を選択していますので、 新たにCombobox2を作りCombobox2で指定した日付(行)を選択し入力できる様に作成 したいのですが・・・今、使っているコードを基にCommandbox2を追加して作成できますでしょうか？ 現在のコードは下記です。 Private Sub UserForm_Initialize() Dim i As Long For i = 1 To 12 Me.ComboBox1.AddItem i & "月" Next End Sub Private Sub CommandButton1_Click() Dim myRng As Range Dim rng As String Select Case ComboBox1.Value Case "1月": rng = "az76" Case "2月": rng = "be76" Case "3月": rng = "bj76" Case "4月": rng = "ak41" Case "5月": rng = "ap41" Case "6月": rng = "au41" Case "7月": rng = "az41" Case "8月": rng = "be41" Case "9月": rng = "bj41" Case "10月": rng = "ak76" Case "11月": rng = "ap76" Case "12月": rng = "au76" Case Else: Exit Sub End Select Set myRng = Range(rng).End(xlUp).Offset(1) myRng.Value = TextBox1.Value End Sub
- ベストアンサー
- Visual Basic
- エクセルVBAで複数列データを１列に配列替えしたい
先日この欄で教えていただいたのですが、 確認を忘れてしまい、うまくゆかないので再質問させていただきます。 複数列の複数行（例A列3行～F列20行）に関数式によるデータが入っています。 これを縦１列に配置替えしてテキストにoutputするということで次のVBAを教えてもらったのですが 途中で止まってしまいました。お知恵を貸してください。 Sub closs() Dim myRng As Range Dim i As Long Sheets("データシート").Select Set myRng = Range(ActiveCell, ActiveCell.End(xlDown).End(xlToRight)) Sheets("貼り付け").Select For i = 1 To myRng.Columns.Count Range("A1").Offset((myRng.Rows.Count) * (i - 1)).Resize(myRng.Rows.Count) _ = myRng.Columns(i).Value Next End Sub ※例としてA列3行～F列20行を１グループとして縦１列に配列替えをしてテキストに出力する。 ※マウスによるカーソル位置をデータトップのA3またはそれより上の空欄において実行する。 ※グループの途中（例A21～F24）を空欄（関数式なし）として次のグループが存在し、グループか存在する場合同じ作業を繰り返し 別のテキストにoutputする。 ※列を増やしたい場合の対応もできるようにしておく。 よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- エクセルVBAで（続）
前日も質問（http://okweb.jp/kotaeru.php3?q=1480399）を出していたものですが、続きがあります。下記は今現在のコードです。 Sub 得意先追加() Sheets("一覧").Unprotect Dim myRng As Range, a Sheets("新規").Copy before:=Sheets(4) With ActiveSheet .Unprotect 得意先シート登録.Show .Name = .Range("A4").Value & .Range("A3").Value .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True Set myRng = Sheets("一覧").Range("A65536").End(xlUp).Offset(1) myRng.Value = .Range("A4").Value & .Range("A3").Value Sheets("一覧").Hyperlinks.Add _ Anchor:=myRng, _ Address:="", _ SubAddress:=myRng.Value & "!A1", _ TextToDisplay:=myRng.Value End With Sheets("一覧").Select Range("A4").Activate Selection.End(xlDown).Select ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True End Sub 実は一覧シートのA列はコード＆得意先名ですが、B列には今期の売上合計(各得意のシートのP10をリンク貼付),D列には前期の売上合計(各得意先のP9よりリンク貼付)があります。 それで,得意先追加を実行しているときに一覧シートのB列・D列にシートの各セルをリンク貼付するにはということなんですが、教えていただけますでしょうか。 宜しくお願いします。
- ベストアンサー
- Visual Basic
- excel vba DATAの日集計
excel vba DATAの日集計 いつもお世話になっています。 "DATA"シートのセル"D2"の日付を変えると表の数値が変わるようにしています。 その日毎のデータを"集計"シートの日別の表に飛ぶようにしているのですが、 １日分の転記するセル数が多く、Select Caseで３１日分のコードを書くと、あまりにも プロシージャーが大きくなります。（Case1からCase31・・・結果分割してますが） FOR NEXT なのかな～、もっと効率のいい書き方がありましたらよろしくお願いします。 例："集計"シート１日分は、9行となります。それぞれ"DATA"シートからの転記です。"DATA"シートのF5+F10,G5+G10~AC5+AC10までそれぞれの値を"集計"シートのG5からAD5まで、F6+F12,G6+G12~AC6+AC12までそれぞれの値を"集計"シートのG13からAD13までといった具合です （日の9行はそれぞれ決まったある行とある行の加算です、これが３１日分の行があります） Sub macro() Dim myrng As Range Dim c As Range Set myrng = Sheets("DATA").Range("D2") For Each c In myrng Select Case c.Value Case 1 '１行目 Sheets("集計").Range("G5").Value = Sheets("DATA").Range("F5") + Sheets("DATA").Range("F10") | | Sheets("集計").Range("AD5").Value = Sheets("DATA").Range("AC5") + Sheets("DATA").Range("AC10") | | '９行目Sheets("集計").Range("G13").Value = Sheets("DATA").Range("F6") + Sheets("DATA").Range("F12") | | Sheets("集計").Range("AD13").Value = Sheets("DATA").Range("AC6") + Sheets("DATA").Range("AC12")
- ベストアンサー
- Visual Basic
- ＶＢＡの転記について
With Sheets("入力") '3行目～22行目まで For i = 5 To 24 SheetName = Sheets("入力").Cells(i, "C").Value On Error Resume Next Set Dummy = Sheets(SheetName) SheetName2 = .Cells(i, "C").Value U最終行 = Sheets(SheetName2).Range("C65536").End(xlUp).Row + 1 If U最終行 = 39 Then Sheets(SheetName2).Copy BEFORE:=ActiveSheet Sheets(SheetName).Delete End If If Err.Number = 0 Then A = Sheets(SheetName2).Range("C65536").End(xlUp).Row + 1 Sheets(SheetName2).Range("C" & A).Value = .Cells(i, "G").Value Sheets(SheetName2).Range("D" & A).Value = .Cells(i, "I").Value Sheets(SheetName2).Range("E" & A).Value = .Cells(i, "L").Value Sheets(SheetName2).Range("F" & A).Value = .Cells(i, "N").Value Sheets(SheetName2).Range("G" & A).Value = .Cells(i, "P").Value Sheets(SheetName2).Range("H" & A).Value = .Cells(i, "R").Value Sheets(SheetName2).Range("I" & A).Value = .Cells(i, "T").Value Sheets(SheetName2).Range("K" & A).Value = .Cells(i, "V").Value Sheets(SheetName2).Range("L" & A).Value = .Cells(i, "X").Value ElseIf .Cells(i, "C").Value <> "" Then G = Sheets("原紙").Range("C65536").End(xlUp).Row + 1 Sheets("原紙").Range("B1").Value = .Cells(i, "D").Value Sheets("原紙").Range("B4").Value = .Cells(2, "D").Value Sheets("原紙").Range("C" & G).Value = .Cells(i, "G").Value Sheets("原紙").Range("D" & G).Value = .Cells(i, "I").Value Sheets("原紙").Range("E" & G).Value = .Cells(i, "L").Value Sheets("原紙").Range("F" & G).Value = .Cells(i, "N").Value Sheets("原紙").Range("G" & G).Value = .Cells(i, "P").Value Sheets("原紙").Range("H" & G).Value = .Cells(i, "R").Value Sheets("原紙").Range("I" & G).Value = .Cells(i, "T").Value Sheets("原紙").Range("K" & G).Value = .Cells(i, "V").Value Sheets("原紙").Range("L" & G).Value = .Cells(i, "X").Value '原紙をコピーする Sheets("原紙").Copy BEFORE:=Sheets(1) 'シートの名前を市場コードにする Sheets(1).Name = SheetName End If Next i End With On Error GoTo 0 上記のＶＢＡを作成しましたが、 C行の値ごとの転記(Ｇ～Ｘの値)が出来ません。 どこが間違いか教えていただけないでしょうか。
- ベストアンサー
- Visual Basic
- Excel collectionについて VBA
Dim Mydata As New Collection Dim i As Long Dim EndNumber As Long On Error Resume Next 'データを登録する間、エラーを無視する For i = 2 To EndNumber '2行目から最終行までチェック Mydata.Add Range("J" & i).Value, Range("J" & i).Value 'J列のデータ取得 Next i On Error GoTo 0 i = 1 For Each A In Mydata Worksheets("Sheet1").Range("A" & i).Value = A i = i + 1 Next A 現在見ているシートの重複しない項目を 別シートに書き込みしているプログラムになります。 様々なサイトを参考にさせて頂き、 上記のような結果になり、 文字列は取得できるようになりました。 しかし、もとになるデータがある位置に（例は、J列） 数値が入っていると上手くコレクションに入ってくれません。 J列に文字列（りんご、ごりらなど）が入っている場合は 重複しない項目がコレクションに格納されていきます。 J列に文字列（0,1)が入っていた場合、 重複しない項目もなにも無く、 ローカルのMydataの中には<変数無し>とありました。 このプログラムの何処を直せば、数値をコレクションとして取得できますか？ ちなみに、EndNumberには最終行の数値が入っています。 ＞Mydata.Add Range("J" & i).Value, Range("J" & i).Value 'J列のデータ取得 .valueを.stringにしても効果はありませんでした。 回答よろしくお願いいたします。
- ベストアンサー
- Excel（エクセル）
- エクセルのVBAで質問があります。
現在自分はカレンダーを作成していて、カレンダーに祝日を入れたいと思っています そこで これを if文もしくはselectcase どっちを使ったら楽か教えてもらいたいです Sub MakeCalendar(hi As Date) Dim i As Integer 'カレンダーにセットする日付 Dim g As Integer '日付をセットする行番号 Dim r As Integer '日付をセットする列番号 Dim lastDay As Integer '作成するカレンダーの月末 g = 2 'その月の開始曜日を算出 r = Weekday(DateSerial(Year(hi), Month(hi), 1), vbSunday) '指定された日付の翌月１日をもとて、日付の前の日を計算する lastDay = Day(DateSerial(Year(hi), Month(hi) + 1, 1) - 1) For i = 1 To lastDay 'iに日付の設定 Cells(g, r).Value = i If r = 7 Then r = 1 '戻して g = g + 1 '1行下に書く Else r = r + 1 '１列→に移動する End If Next End Sub Sub test() Range("A2:G7").Value = "" 'A2～G2にカレンダー表示 MakeCalendar Range("I2").Value 'I2に日付を入力する End Sub Sub test() Range("A2:G7").Value = "" 'A2～G2にカレンダー表示 MakeCalendar Range("I2").Value 'I2に日付を入力する End Sub このようなマクロを組んでいまして、祝日（ゴールデンウィークなど)を赤で塗りつぶすような物を考えています。 VBAは初心者でまだあまりわかっていないので、ご教授ください
- 締切済み
- 情報工学
お礼
ありがとうございます！本日出社して早々にこの記述で試してみました。たしかに時間は掛かりましたが、求めていた回答が得られ助かりました。 感謝です。