回答数
気になる
-
IEを使わないでhtmlテキストを取得したい(VB.Net)
見たいサイトがIEに対応していないため、VB標準のWebbrowserが使えません。FireFoxなど他のブラウザでは見ることができるこのサイトをVB.Netを使って情報取得できるでしょうか。
質問日時: 2024/03/16 14:48 質問者: payphone
解決済
1
0
-
VBAで質問があります
ユーザーフォームで入力して転記はできているのですが 転記時に少々遅い気がするのですがコードに問題ありますでしょうか? Private Sub UserForm_Initialize() Me.TextBox1.Value = Format(Now(), "yyyy/m/d") End Sub Private Sub CommandButton1_Click() Dim I As Long Dim iCheck As Integer Dim r As Range Dim Ctrl As Control Set sht = ActiveSheet Set r = sht.UsedRange Cells(r.Row + r.Rows.Count, r.Column).End(xlDown).End(xlUp).Offset(1, 0).Select For I = 2 To 2000 If Cells(I, 2).Value = "" Then Exit For Next '連番 Cells(I, 1).Value = I - 1 '日付 Cells(I, 2).Value = Me.TextBox1.Value '分類 Cells(I, 3).Value = Me.ComboBox1.Value '品名 Cells(I, 4).Value = Me.ComboBox2.Value '個数 Cells(I, 5).Value = Me.TextBox2.Value '単価 Cells(I, 6).Value = Me.TextBox3.Value '合計 Cells(I, 7).Value = Me.TextBox2 * Me.TextBox3.Value '支払い方法 Cells(I, 8).Value = Me.ComboBox3.Value '備考 Cells(I, 9) = Me.TextBox4.Value Me.TextBox3.Text = "" Me.TextBox4.Text = "" Me.ComboBox2.SetFocus End Sub
質問日時: 2024/03/16 12:18 質問者: maniac
ベストアンサー
5
0
-
VBAの質問になります 行の非表示
あまり見ない行の非表示設定ができればと思います B列に日付はあります、その日付から2週間以前を自動で(エクセルを開いたら)非表示にしたいです 1行目は項目がありますので表示のままが良いです どこにどのようなコードで動くようになりますでしょうか?
質問日時: 2024/03/16 00:53 質問者: maniac
ベストアンサー
2
0
-
ExcelVBA シート名を複数セルから取得して変更
VBA超ビギナーです。 シート名をセルから取得して変更するVBAをご教授願えませんでしょうか...。 ①シート名「シート名変更」「日付変更」以外の全てのシートのシート名を変更 ②値はシート「シート名変更」のA2〜A16から取得
質問日時: 2024/03/15 16:08 質問者: kkkkk_99
ベストアンサー
6
0
-
ExcelのVBAコードについて教えてください。
作業ブックの作業シートに Private Sub Worksheet_Change(ByVal Target As Range) を設定しています。 このコードに下記のコードを追加したいのですが、教えてください。 セルC14 C16 C18にせれぞれプルダウンで選択した文字が表示されます 文字は固定文字で「審査」です 3つのセルには必ず1つだけ「審査」が表示されていれば良く 例えばC14に「審査」と表示し 次に16に「審査」を表示させると 最初のC14の「審査」は削除 同じく C18に「審査」を表示させると 次に表示させたC16の「審査」は削除です 例は順番をC14からにしてますが 順番は順不同です 各セルはセルを結合してますので 見た目は縦に3つ並んでます よろしくお願いします。 親切にコードを全て教えてください。 宜しくお願い致します。
質問日時: 2024/03/15 08:31 質問者: エクセル小僧
ベストアンサー
5
0
-
解決済
3
0
-
VBA UserFormからの転記で
画像のように一度にまとめて転記はできるのでしょうか? 参照は管理№の記載列B列になり、その該当した行の18=使用日・ 19=設置または搭載先・20=登録者・21=メモになります 該当する行にそれぞれ転記したいのですが可能でしょうか? 現状このような感じです(中略) 1行だけだと転記できましたが複数になるとダメでした(´;ω;`) '該当管理№があったらを複数作成すればよいのでしょうか? If Cells(iCheck, 2).Value = Me.TextBox2.Text Then If Cells(iCheck, 2).Value = Me.TextBox5.Text Then この場合、Exit SubとEnd Ifを書くコードに追加ですかね? Private Sub CommandButton1_Click() Dim i As Integer Dim iCheck As Integer For i = 2 To 20000 If Cells(i, 2).Value = "" Then Exit For Next '重複チェック iCheck = i For iCheck = 1 To i '該当管理№があったら If Cells(iCheck, 2).Value = Me.TextBox2.Text Then '出荷されてなかったら 'If Cells(iCheck, 23).Value = "" Then '使用日 Cells(iCheck, 18).Value = Me.TextBox1 Cells(iCheck, 18).Value = Me.TextBox1 '使用先/搭載埼 Cells(iCheck, 19).Value = Me.TextBox3 Cells(iCheck, 19).Value = Me.TextBox6 '担当 Cells(iCheck, 20).Value = Me.ComboBox1 Cells(iCheck, 20).Value = Me.ComboBox1 'メモ Cells(iCheck, 21).Value = Me.TextBox4 Cells(iCheck, 21).Value = Me.TextBox7
質問日時: 2024/03/14 14:04 質問者: kacky76
ベストアンサー
3
0
-
ExcelのVBAコードについて教えてください。
作業ブックのシートに下記のコードを設定しております。 セル「C12」に「審査」と表示されると非表示シート「確認質疑」と「行政回答確認」 が表示出来るようになっております。 この2つのコードを1つのコードにまとめる方法を教えてください。 現状のコード Private Sub Worksheet_Change(ByVal Target As Range) Sheets("確認質疑").Visible = [C12] = "審査" Sheets("行政回答確認").Visible = [C12] = "審査" End Sub 以上となります。 宜しくお願い致します。
質問日時: 2024/03/13 09:23 質問者: エクセル小僧
ベストアンサー
1
0
-
【ExcelVBA】インデックスが有効範囲にありません。の理由が分かりません
下記、VBAソースの一部ですが、やりたい処理は、 本体のマクロブックのSheet1のA2セルにフォルダのパスが、 C2、D2セルにセル位置が記載されています。 そのフォルダ内のすべてのエクセルを順番に開いて指定シートの指定範囲をコピーしたいのです。 各ブックのシート名は異なるのですが、VBAエディタから見たシートの番号はすべて同じなので、シート番号から特定して処理しようと考えました。 開いたブックのSheetIDが28のシートに対して、LeftUp(左上)から右下(RightDown)の範囲をコピーしたいのですが、 「インデックスが有効範囲にありません。」というエラーでストップしてしまいます。 LeftUp = Cells(2, 3).Value ' C2 RightDown = Cells(2, 4).Value ' D2 buf = Dir(Sheets("Sheet1").Range("A2").Value & "*.xlsm") Workbooks.Open Worksheets("Sheet1").Range("A2").Value & "\" & buf, UpdateLinks:=0 Worksheets(28).Range(LeftUp & ":" & RightDown).Copy 原因を教えて頂けると助かります。
質問日時: 2024/03/13 00:34 質問者: tanapyondai
解決済
3
1
-
PDF出力マクロについて。マクロ初心者です。 エクセルで、アクティブシートを指定したフォルダに保存す
PDF出力マクロについて。マクロ初心者です。 エクセルで、アクティブシートを指定したフォルダに保存するマクロを組んだのですが、ドライブが違う人でも作動するようにするにはどうしたら良いでしょうか?そもそも不可能なのでしょうか。 コードは以下になります ……………………………………………………………………… Sub アクティブシートPDF出力() Dim strPath As String strPath = "V\○○○○"(指定フォルダのフルパス) Dim ShName As String ShName = ActiveSheet.Name With ActiveSheet.PageSetup Zoom = False FitToPagesWide = 1 FitToPagesTall = 1 End With If MsgBox(ShName &"シートをPDF形式で出力します。よろしいですか?", vbQuestion + vbYesNo) = vbNo Then MsgBox "中止しました。"Exit Sub End If ActiveSheet.ExportAsFixedFormat _ Type:=xlTypePDF, _ Filename:=strPath &"\"&ActiveSheet.Range("B8").Text &"_"&Sheets(ShName).Name &".pdf"End Sub ……………………………………………………………………………… また、無駄な部分や追加した方がいいもの等ありましたらアドバイスいただけたらと思います。
質問日時: 2024/03/11 12:44 質問者: chuntarosa__n
ベストアンサー
1
0
-
Excelで「Ctrl+c」、「Ctrl+v」等をまとめた物
Excelで「Ctrl+c,v」はよく使います。同様に「Ctrl+a」等もあればと思います。まとめて発表されておればそのアドレスを教えてください。
質問日時: 2024/03/11 06:23 質問者: aerio
ベストアンサー
5
0
-
VBAコードについて
Sub setData() Dim hitCol As Long Dim i As Long, j As Long Dim errDays() As Long, errCnt As Long '入力データチェック If Not chkData Then End Application.ScreenUpdating = False 'データ登録 With Sheets(strSheet) For i = 1 To 5 If days(i) <> 0 Then Err.Clear hitCol = WorksheetFunction.Match(days(i), .Rows(7), 0) If Err.Number = 0 Then For j = 1 To 27 '組立・行程 .Cells(hitRow + j, hitCol).Value = Cells(j + 9, i * 2 + 2).Value Next j .Cells(hitRow + 30, hitCol).Value = Cells(39, i * 2 + 2).Value '生産数 .Cells(hitRow + 32, hitCol).Value = Cells(40, i * 2 + 2).Value '作業工数 .Cells(hitRow + 33, hitCol).Value = Cells(41, i * 2 + 2).Value 'ケース数 Else errCnt = errCnt + 1 ReDim Preserve errDays(errCnt) errDays(errCnt) = i End If End If Next i End With ThisWorkbook.Save If errCnt = 0 Then Application.ScreenUpdating = True MsgBox "データを[" & strSheet & "]シートにセットしました。", vbInformation Else For i = 1 To errCnt Cells(8, errDays(i) * 2 + 2).Interior.Color = vbYellow Next i Application.ScreenUpdating = True MsgBox "[" & strSheet & "]シートに該当する日が無かったため、データをセットできませんでした。" & vbCrLf & "シートを確認してください。", vbExclamation End If Sheets(strSheet).Activate Application.GoTo Cells(hitRow, "C"), True End Sub のようなコードがあります。 セルC19、C20、D30、D31のデータはセットしないようにしたいのですがどうしてもわかりません。 教えて頂けないでしょうか。お願い致します。
質問日時: 2024/03/10 12:41 質問者: Chiたん
ベストアンサー
2
0
-
解決済
2
0
-
解決済
2
0
-
VBAのコードを教えてください
昨日からVBAを始めた初心者です。 どなたか助けて頂けないでしょうか…。 sheet1からsheet5まであるExcelです。 バージョンは2021 sheet1に集計シートを作っています。 sheet1のC2からC149まで社員番号があり sheet2からsheet5はA2からA41まで それぞれ社員番号があります。 やりたいことは sheet2からsheet5の社員番号が sheet1の社員番号に一致したら sheet2からsheet5のE.F.G.H.I.J列を E.G.I.F.H.J列の順でコピーし sheet1の一致した社員番号のE.F.G.H.I.J列に貼り付けたいです。 更にsheet2からsheet5のD列を sheet1のM列に貼り付けたいです。 sheet1は A1:M149の大きさ sheet2からsheet5は A1:J42の大きさ セルの結合は無しです。 1行目に項目名がある感じで作っています。 文字だけでは伝わりにくいかもしれませんが わかる方、よろしくお願い致します。
質問日時: 2024/03/08 14:15 質問者: いぬ1230
ベストアンサー
5
0
-
以下のコードを実行しても、オブジェクト変数または、withブロック変数が設定されていませんとエラーが
以下のコードを実行しても、オブジェクト変数または、withブロック変数が設定されていませんとエラーが発生します。ネットで解決策を色々と試してみましたが、どうしても実行できません。 VBA初心者です。どなたか、助けて頂けないでしようか? Option Explicit Sub ガントチャート描画() Dim al As Range Dim org As Range Dim dst As Range For Each al In Range("al7:al29") If al.Value <> "" Then Call MyFind(al.Value, org) Call MyFind(al.Offset(0, 3).Value, dst) If al.Offset(0, 7).Value = "H" Then With ActiveSheet.Shapes.AddLine(org.Left + 0, _ al.Top + 10, dst.Left + 0, al.Top + 10).Line .EndArrowheadStyle = msoArrowheadTriangle .ForeColor.RGB = RGB(250, 8, 8) .Weight = 3 End With ElseIf al.Offset(0, 7).Value = "A" Then With ActiveSheet.Shapes.AddLine(org.Left + 0, _ al.Top + 10, dst.Left + 0, al.Top + 10).Line .EndArrowheadStyle = msoArrowheadTriangle .ForeColor.RGB = RGB(51, 255, 0) .Weight = 3 End With ElseIf al.Offset(0, 7).Value = "K" Then With ActiveSheet.Shapes.AddLine(org.Left + 0, _ al.Top + 10, dst.Left + 0, al.Top + 10).Line .EndArrowheadStyle = msoArrowheadTriangle .ForeColor.RGB = RGB(51, 255, 0) .Weight = 3 End With Else: With ActiveSheet.Shapes.AddLine(org.Left + _ 0, al.Top + 10, dst.Left + 0, al.Top + 10).Line .EndArrowheadStyle = msoArrowheadTriangle .ForeColor.RGB = RGB(0, 0, 128) .Weight = 3 End With End If End If Next End Sub Private Sub MyFind(ByVal src As String, ByRef rng As Range) Dim r As Range Set rng = Nothing For Each r In Range("at5:lu5") If r.Value = src Then Set rng = r Exit Sub End If Next End Sub
質問日時: 2024/03/07 16:21 質問者: かなもゆ
ベストアンサー
1
0
-
【ExcelVBA】VBA実行でダイアログメッセージを無視する方法はありますか?
VBAの処理で、フォルダ内のブックを順番に開きながらコピーしていくといった処理をしてるのですが、 ブックの中には、他のブックを参照する式が入っていた場合、 「更新する」「更新しない」といった問い合わせが表示されてしまい、 いちいちクリックする必要があります。 全て「更新しない」選択を自動化して中断させない方法はありますか?
質問日時: 2024/03/07 11:23 質問者: tanapyondai
解決済
1
0
-
VBAコードについて教えてください、 下記のコードを一つにまとめる方法を教えてください セルF18に
VBAコードについて教えてください、 下記のコードを一つにまとめる方法を教えてください セルF18に "フラット設計審査_標準計算" が表示され 又は セルF18に"フラット設計審査_仕様基準" が表示されると マクロ フラットシート表示が実行出来る方法を教えてください 現状の別々のコードです If Range("$F$18").Value = "フラット設計審査_標準計算" Then Call フラットシート表示 End If If Range("$F$18").Value = "フラット設計審査_仕様基準" Then Call フラットシート表示 End If よろしくお願いします
質問日時: 2024/03/06 20:11 質問者: エクセル小僧
ベストアンサー
2
0
-
ExcelのVBAコードについて教えてください。
先日来より、ここで質問をさせて頂いておりますが、皆様の回答を頂きましたが、 解決に至っておりませんので、改めて質問をさせて頂きます。 作業ブックのシート名「審査」に下記のコードを設定しております。 このブックを使用する手順として、一番産所にセル「F18」をプルダウン選択し、文字を表示させて、作業を進めておりますが、「F18」に「確認申請」を選択するとその後、コードの内、下記のコードが実行できません。 If Target.Address = "$F$15" Then Call 担当者情報総合 End If If Target.Address = "$D$18" Then Call 審査保存1 End If 「F18」に「確認申請」以外を選択するとシートに設定しているすべてのコードが順調に実行できます。 「F18」に「確認申請」を選択すると If Range("$F$18").Value = "確認申請" Then Call 確認シートコピー End If が実行されますが、このコードに問題があるのでしょうか。 マクロ「確認シートコピー」は Sub 確認シートコピー() Call 確認用シート表示 Dim i As Integer i = 1 Do While i > 0 i = i + 1 If i > 1 Then Exit Do End If Debug.Print i Loop Sheets("確認申請シート").Select Range("B1:I52").Select Selection.Copy Sheets("質疑").Select Range("B1:I52").Select ActiveSheet.Paste ActiveWindow.SmallScroll Down:=0 Sheets("確認申請シート").Select ActiveWindow.ScrollColumn = 9 ActiveWindow.ScrollColumn = 10 ActiveWindow.ScrollColumn = 13 ActiveWindow.ScrollColumn = 14 ActiveWindow.ScrollColumn = 15 ActiveWindow.ScrollColumn = 16 ActiveWindow.ScrollColumn = 17 ActiveWindow.ScrollColumn = 18 ActiveWindow.ScrollColumn = 20 Range("AC24:AC52").Select Selection.Copy Sheets("質疑").Select ActiveWindow.SmallScroll ToRight:=21 Range("AC24:AC52").Select ActiveSheet.Paste ActiveWindow.ScrollColumn = 21 ActiveWindow.ScrollColumn = 14 ActiveWindow.ScrollColumn = 12 ActiveWindow.ScrollColumn = 1 Call 確認用シート非表示 Call F行調整 Range("F15").Select End Sub です。 シート名「審査」の全体のコードは Private Sub Worksheet_Change(ByVal Target As Range) If Range("$F$18").Value = "フラット設計審査_標準計算" Then Call フラットシート表示 End If If Range("$F$18").Value = "フラット設計審査_仕様基準" Then Call フラットシート表示 End If If Target.Address = "$F$18" Then Call 担当者メッセージ End If If Target.Address = "$F$15" Then Call 担当者情報総合 End If If Range("$F$18").Value = "確認申請" Then Call 確認申請関係シート表示 End If If Range("$F$18").Value = "確認申請" Then Call 確認シートコピー End If If Range("$F$18").Value = "確認申請" Then Call 電子行政選択表示 End If If Range("$F$18").Value = "確認申請" Then Call 行政メッセージ End If If Target.Address = "$D$18" Then Call 審査保存1 End If End Sub 以上となります。 「F18」に「確認審査」を表示させても全てのコードが上手く行くように解決できる方法を教えてください。宜しくお願い致します。
質問日時: 2024/03/06 13:07 質問者: エクセル小僧
ベストアンサー
1
0
-
ExcelのVBAコードについて教えてください。
作業ブックのシートに下記のコードを設定しております。 If Target.Address = "$F$15" Then Call 担当者情報総合 End If このコードは、セルF15に不特定の文字が表示されるとマクロ「担当者情報総合」が実行されますが、 このコードに「指定シート名」を追加できる方法を教えてください。 指定シート名は「質疑」としてください。 同じく If Range("$F$18").Value = "確認申請" Then Call 確認申請関係シート表示 End If このコードは、セルF18に「確認申請」と文字が表示されるとマクロ「確認申請関係シート表示」が実行されますが、 このコードに「指定シート名」を追加できる方法を教えてください。 指定シート名は「質疑」としてください。 以上となります。 宜しくお願い致します。
質問日時: 2024/03/05 09:03 質問者: エクセル小僧
ベストアンサー
4
1
-
エクセルVBAの配列について
VBA初心者です。 ワークシートのリストを配列に取り込むに当たって 特定の列を一挙に取り込むにはどうすれは良いでしょうか。 Array_data(,3)=range(cells(1,7),range(cells(rows.count,7).end(xlup).row,7) とか Array_data.columns(3)=range(cells(1,7),range(cells(rows.count,7).end(xlup).row,7) を試してみたのですがうまくいきません。 よろしくお願いします。
質問日時: 2024/03/04 16:21 質問者: eHiro401
解決済
1
0
-
エクセルvbaについて
tatsumaru77様 以前投稿した内容で転記の追加をしたいのですが、内容は別ファイルへの転記をB列の1行目から添付の内容をお願いします。A列の転記内容はそのままでいいです。 AA0000Z00001* B列にはS列とU列の転記はなしです。 それとこのコードだと転記した後に、もう一度転記処理を行うと最初に転記したものが消えてしまいます。一度転記したものは消さずにその下から転記されるようにしたいです。A列B列も同じようにです。 自分で変更してみましたが、うまくいきません。 申し訳ありませんが、よろしくお願いいたします。 Public Sub 別ファイルへ転記() Dim fpath As String Dim wb As Workbook Dim ws1 As Worksheet Dim wb2 As Workbook Dim ws2 As Worksheet Dim maxrow1 As Long Dim row1 As Long Dim row2 As Long Set ws1 = ActiveSheet fpath = "C:\Users\t-tai\OneDrive\デスクトップ\図番\図番転記.xlsx" Set wb2 = Nothing For Each wb In Workbooks If wb.Name = "図番転記.xlsx" Then Set wb2 = wb Exit For End If Next If wb2 Is Nothing Then Set wb2 = Workbooks.Open(fpath) End If Set ws2 = wb2.Worksheets(1) ws2.Cells.ClearContents row2 = 1 maxrow1 = ws1.Cells(Rows.Count, "C").End(xlUp).Row For row1 = 13 To maxrow1 If ws1.Cells(row1, "A").Value = "○" Then ws2.Cells(row2, "A").Value = ws1.Cells(row1, "C").Value & ws1.Cells(row1, "E").Value & ws1.Cells(row1, "K").Value & _ ws1.Cells(row1, "O").Value & ws1.Cells(row1, "S").Value & ws1.Cells(row1, "U").Value & "*" row2 = row2 + 1 End If Next or row1 = 13 To maxrow1 If ws1.Cells(row1, "A").Value = "○" Then ws2.Cells(row2, "B").Value = ws1.Cells(row1, "C").Value & ws1.Cells(row1, "E").Value & ws1.Cells(row1, "K").Value & _ ws1.Cells(row1, "O").Value & "*" row2 = row2 + 1 End If Next End Sub
質問日時: 2024/03/02 01:11 質問者: Wrangleruk
ベストアンサー
6
0
-
エクセルのマクロについて教えてください。
シート名「審査」に下記のコードを設定しておりますが、 下記のコードが上手く実行されない原因の解決方法を教えてください。 下記のコードは指定セル値の変更により指定マクロが実行されますが、 例えば 一番最初に セルF15を変更すると上手く指定マクロが実行されます、その後、セルF18を変更した場合は、指定マクロが実行されません、同じくセルD18を変更した場合もマクロが実行されません。 違うパターンで 最初にF18を変更するとマクロが実行され、その後、F15や D18を変更してもマクロが実行できません。 もう一つ違うパターンで 最初にD18を変更するとマクロが実行され、 その後、F15やF18を変更するとマクロが実行されません。 結論として、F15・F18・D18のどれか一つを変更した後は、残りのセルを変更してもマクロが実行されないのです。 解決方法を教えてください。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$F$15" Then Call 担当者情報総合 End If If Target.Address = "$F$18" Then Call 担当者メッセージ End If If Target.Address = "$D$18" Then Call 審査保存1 End If End Sub 上記のコードは指定セル値に不特定の文字が表示された時に指定マクロが実行出来るようにしてますが、上手く実行できません。 その他のコードは上手く実行できます。 原因は上手く実行されないコードは不特定の文字の表示 上手く実行できるコードは特定の文字の表示にあるのでしょうか? 宜しくお願い致します。 以上となります。 宜しくお願い致します。 Visual Basic | Excel・163閲覧・25
質問日時: 2024/03/01 17:04 質問者: エクセル小僧
ベストアンサー
2
0
-
Excel関数またはVBAでの質問になります
セル内の文章内で"[説明]"を先頭に空白までを抜粋して別のセルに表示できませんか? LEFT・MID・RIGHT・FIND関数は試しました =MID(B2,FIND("[説明]",B2),60) =LEFT(B2,60) 表示させる文字数が各セルでまちまちなので指定ができません 指定してしまうと他の項目まで表示してしまうためできれば説明文のみが希望です なので最後の空白または次の[]手前までで〆れば 説明文章のみ表示できるかなと思ったのですが(;^_^A ちなみに関数では表示のみですがVBAでは転記できるのでしょうか? B列に貼り付けたらC列に[説明]から空白までまたは次の[]手前までが転記出来たらありがたいです
質問日時: 2024/02/29 16:06 質問者: kacky76
解決済
5
1
-
VBA 複数の各シートに行を追加したいです
お世話になっております。 複数の各シートに行を追加したいです。 コードを考えてみました。 以下のコードで相違ないでしょうか。 Sub Test2() Dim Wb1 As Workbook, Wb2 As Workbook Dim Ws1 As Worksheet, Ws2 As Worksheet Dim LastRow1 As Long, LastRow2 As Long Dim sheetNames As Variant Dim i As Integer ' ソースのWorkbookを定義 Set Wb1 = Workbooks("Book1.xlsm") ' ターゲットのWorkbookを定義 Set Wb2 = Workbooks("Book2.xlsm") ' シート名の配列を定義 sheetNames = Array("Sheet2", "Sheet3", "Sheet4", "Sheet5", "Sheet6", "Sheet7", "Sheet8", "Sheet9", "Sheet10", "Sheet11", "Sheet12", "Sheet13", "Sheet14") ' 各シートにループ For i = LBound(sheetNames) To UBound(sheetNames) ' ソースのWorksheetを定義 Set Ws1 = Wb1.Sheets(sheetNames(i)) ' ターゲットのWorksheetを定義 Set Ws2 = Wb2.Sheets(sheetNames(i)) ' 最終行を見つける LastRow1 = Ws1.Cells(Ws1.Rows.Count, "C").End(xlUp).Row LastRow2 = Ws2.Cells(Ws2.Rows.Count, "C").End(xlUp).Row ' コピーと挿入 Ws1.Rows("2:" & LastRow1).Copy Ws2.Rows(LastRow2 + 1).Insert Shift:=xlDown ' クリップボードをクリア Application.CutCopyMode = False ' オブジェクト参照を解放 Set Ws1 = Nothing Set Ws2 = Nothing Next i ' オブジェクト参照を解放 Set Wb1 = Nothing Set Wb2 = Nothing End Sub ご回答をお待ちしております。 どうぞ宜しくお願い申し上げます。
質問日時: 2024/02/28 22:09 質問者: yuri_7
解決済
2
0
-
VBA 別ブックからコピペしたいのですが、軽くしたいです
VBAかなり初心者です。 シンプルなVBAのフォーマットを作成してみましたが、とっても遅いです。 色々調べたものの、自分でやりたいことが軽いコードでできませんでした…。 1.別のブックは毎回ブックネームが異なるため、ファイルから選択する形式を希望 (今回はREPORT.xlsxのFinal Dataシートより) 2.そのブックの列ごとコピーして、このVBAが入っているブック(Book1.xlsm)のDataシートに貼付けをしたい ************************************************************************* Sub Sample2() '別ブックを開く Dim OpenFileName As String OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls?") If OpenFileName <> "False" Then Workbooks.Open OpenFileName End If 'データをコピー 上記で選択して開いた別ブック Windows("REPORT.xlsx").Activate a = Sheets("FinalData").Select Columns("A:A").Select Application.CutCopyMode = False Selection.Copy 'データをペースト Windows("Book1.xlsm").Activate Sheets("Data").Select Columns("A:A").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("A1").Select Application.CutCopyMode = False Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove End Sub ************************************************************************ いくつか速くできるようなQ&AのWEBページがあったのですが、なかなかうまく回りませんでした…。 コードを教えていただけると大変助かります。 何卒よろしくお願いいたします。
質問日時: 2024/02/26 18:41 質問者: Sakokosan
解決済
3
0
-
VBA 別ブックから条件に合うものを転記したいです
上の表を埋めるため、別ブックの下の表から条件に合うセルを転記し、また、空白のセルに[x]を入れたいです。 東京-りんご セルB2に入るのはa(B4) セルC2、D2はx VBA初心者の為、なかなか上手く行かず、、、 ご教授よろしくお願いします。
質問日時: 2024/02/25 21:39 質問者: moff12010816
ベストアンサー
3
0
-
配列のペースト出力結果の書式について
配列のペースト出力結果の書式について、どうも書式が反映されなくて困っております。 dim AllmydataArr as Variant dim SourceRng as range, TargetRng as range wbとmbは それぞれのBookのパス先です Set SourceRng = Wb.Worksheets("sheet5").UsedRange AllmydataArr = SourceRng Set TargetRng = mb.Worksheets("sheet1").Range("A1") TargetRng.Resize(UBound(AllmydataArr, 1), UBound(AllmydataArr, 2)) = AllmydataArr と現在このようにResizeとUBoundをつかって配列AllmydataArrのペースト出力結果を出しております。 このままでは値貼り付けで終わってしまい、書式の移動ができておりません。 NumberFormat を使おうにもエラーがでてしまいます。 どのようにVBAを表現すると元のSheetにある書式が反映されるようになるのでしょうか。 教えていただけると幸いです。よろしくお願いいたします
質問日時: 2024/02/25 14:50 質問者: ひかりりあ
ベストアンサー
3
0
-
for 文の 繰り返し処理に使えるのかどうかについて
ExcelのVBA について質問があります。 1つのブックの4つのシートに対して4回違うブックのシートからコピぺを繰り返そうと思っております。 Dim Wb1 As Workbook, Wb2 As Workbook, Wb3 As Workbook, Wb4 As Workbook Dim FullPath1 As String, FullPath2 As String, FullPath3 As String, FullPath4 As String Dim SourceRng1 As Range, SourceRng2 As Range, SourceRng3 As Range, SourceRng4 As Range Dim TargetRng1 As Range, TargetRng2 As Range, TargetRng3 As Range, TargetRng4 As Range Worksheets("kyu").Cells.Clear Worksheets("nyu").Cells.Clear Worksheets("gai").Cells.Clear Worksheets("sesho").Cells.Clear と、dimでの設定が4種類が4回、元のシートのクリアが4回なので、悩んだ挙句 Dim i As Integer For i = 1 To 4 SourceRng(i).Copy TargetRng(i).PasteSpecial Paste:=xlPasteColumnWidths TargetRng(i).PasteSpecial Paste:=xlPasteValues TargetRng(i).PasteSpecial Paste:=xlPasteFormats Application.CutCopyMode = False i = i + 1 Next としました。 .PasteSpecial Paste:=pasteall ではないのは、行うと図にされて貼り付け先に貼り付けされてしまうからです。 結局のところ、Dimで指定した数字は(i)としてfor文で可能なのか Worksheetsは.Cells.Clearでまとめて表現できるのか .PasteSpecial Paste も短く表現できないか 浅学なので、全く解決策が見いだせません。現在は1から4まで直線的にコピペをVBAで行っております。 簡略化できると嬉しいです。 まずは可能かどうか、そして解決方法を教えていただけると嬉しいです よろしくお願いいたします。
質問日時: 2024/02/25 09:52 質問者: ひかりりあ
ベストアンサー
10
1
-
Excelで画像URLを1つずつセルに振り分けたい
ExcelのA1に下記のような画像URLが複数あり、改行された状態で保存されています。 B1,B2,B3,B4,B5に、画像URLを1つずつセルに振り分けたいです。 下記のようにB1に関数を入れ、B1はうまくいきましたが、 B2,B3,B4,B5に繰り返しが出来ていません。 =FILTERXML("<t><s>" & SUBSTITUTE(A1, CHAR(10), "</s><s>") & "</s></t>", "//s") どのように書き替えれば良いでしょうか? よろしくお願いいたします。 https://yahoo.co.jp/images/I/51zE4g7B3XS._AC_.jpg https://yahoo.co.jp/images/I/51mw3kiGQHL._AC_.jpg https://yahoo.co.jp/images/I/518nTESXpUL._AC_.jpg https://yahoo.co.jp/images/I/51s7tENUsoL._AC_.jpg https://yahoo.co.jp/images/I/51Ka9evm3CL._AC_.jpg https://yahoo.co.jp/images/I/51GPh29MXzL._AC_.jpg https://yahoo.co.jp/images/I/51r0QUBwEVL._AC_.jpg"
質問日時: 2024/02/24 01:59 質問者: tutuu
ベストアンサー
2
0
-
Excel VBA 文字列のセルを反映させたいです
大変お世話になっております。 以下のVBAを実行すると、セルの書式設定で『文字列』のセル(例えば、052等、数字の頭が0のため文字列にしたセル)が反映されません…。 (複数のシートを1つのシートにまとめるVBAでして、まとめる前の元のシートに文字列が含まれています) 文字列を反映したいため、コードの修正をしていただけると有難い限りです…。 お手数ですが、コードの全文をご記載いただけると本当に助かります…。 Sub 複数のシートを1つのシートにまとめる() Dim i As Long Dim r As Long Dim s As Long Dim Sh As Worksheet Dim MaxRow As Long Dim MaxCol As Long Dim MyArray As Variant Dim JoinSh As Worksheet Application.DisplayAlerts = False 'シート削除時のアラート停止 For Each Sh In Worksheets If InStr(Sh.Name, "統合") <> 0 Then Sh.Delete 'すでに統合シートが存在する場合は一旦削除 Next Application.DisplayAlerts = True 'シート削除時のアラート停止を解除 s = 1 '最大行を超えた場合次の統合シートを作成するための番号 Worksheets.Add Before:=Worksheets(s) '新規に統合シートを追加 ActiveSheet.Name = "統合" Set JoinSh = ActiveSheet '統合シートを変数に格納 For i = s + 1 To Worksheets.Count 'シートを統合シートの次~末尾までループ With Worksheets(i) '各月シート If i = 2 Then r = 1 '最初だけ項目も取得 Else r = 2 '最初以外は2行目から取得 End If MaxRow = .Cells(Rows.Count, 1).End(xlUp).Row '1列目で最終行を取得 MaxCol = .Cells(1, Columns.Count).End(xlToLeft).Column '1行目で最終列を取得 MyArray = Range(.Cells(r, 1), .Cells(MaxRow, MaxCol)) 'A1~データ末尾まで配列に格納 End With With JoinSh '統合シート MaxRow = .Cells(Rows.Count, 1).End(xlUp).Row '統合シートの1列目で最終行取得 If MaxRow + UBound(MyArray) > Rows.Count Then '最大行を超える場合の処理 s = s + 1 '統合シートの番号を加算 Worksheets.Add Before:=Worksheets(s) '新規に統合シートを追加 ActiveSheet.Name = "統合" & s '名前が同じにならないように番号を追加 Set JoinSh = ActiveSheet '統合シートを変数に格納 MaxRow = JoinSh.Cells(Rows.Count, 1).End(xlUp).Row '統合シートの1列目で最終行取得 End If If .Cells(1, 1) = "" Then '最初だけ1行目から貼り付け Range(.Cells(1, 1), .Cells(UBound(MyArray), MaxCol)) = MyArray Else '最初以外は最終行の次に貼り付け Range(.Cells(MaxRow + 1, 1), .Cells(MaxRow + UBound(MyArray), MaxCol)) = MyArray End If End With Next i End Sub ご回答を心よりお待ちしております。 大変恐縮ですが、どうぞ宜しくお願い申し上げます。
質問日時: 2024/02/24 00:06 質問者: yuri_7
ベストアンサー
2
0
-
10行目にフィルターを使用して見出しがあります。列はA:DFで11行目以降(2000行ぐらい)はデー
10行目にフィルターを使用して見出しがあります。列はA:DFで11行目以降(2000行ぐらい)はデータが入っています。AD10行目のフィルターからワイルドカードを使用して※2113※、※20F※、※20C07※以外をVBAを使用して表示させる方法は、ありますでしょうか?宜しくお願い致します。
質問日時: 2024/02/21 16:09 質問者: ほいほい侍
解決済
4
0
-
Excel VBA マクロ あるフォルダー内の複数のファイルを統合したいです
大変お世話になっております。 ●あるフォルダー内の複数のファイルを1つのファイル統合したいです。 1)複数のファイルのファイル名は異なります。 2)複数のファイルの各々のシート名は同一です。 3)複数ファイルの形式は同一です。 4)一つに統合した際に、シート名・形式を保ったままにしたいです。 現在は… フォルダー内のファイルを一度各シートにし、その後、統合するVBAを使用しています。 統合した際に形式が保てませんし、2度手間になっています…。 ■1■まず…以下を行い Sub フォルダー内のファイルを各シートへまとめる() Dim Filename As String Dim IsBookOpen As Boolean Dim OpenBook As Workbook Dim ShCount As Long With CreateObject("WScript.Shell") .CurrentDirectory = "F:\2024.02.19_複数ファイルを一つにまとめる\新しいフォルダー" 'ここで読み込むフォルダを直接指定するF:\2022.12.01_複数ファイルを一つにまとめる End With Filename = Dir("*.xlsx") Do While Filename <> "" If Filename <> ThisWorkbook.Name Then IsBookOpen = False For Each OpenBook In Workbooks If OpenBook.Name = Filename Then IsBookOpen = True Exit For End If Next If IsBookOpen = False Then ShCount = ThisWorkbook.Worksheets.Count Workbooks.Open (Filename), UpdateLinks:=1 Worksheets.Copy after:=ThisWorkbook.Worksheets(ShCount) Workbooks(Filename).Close savechanges:=False End If End If Filename = Dir() Loop End Sub ■2■次に以下を行い… Sub 複数のシートを1つのシートにまとめる() Dim i As Long Dim R As Long Dim s As Long Dim Sh As Worksheet Dim MaxRow As Long Dim MaxCol As Long Dim MyArray As Variant Dim JoinSh As Worksheet Application.DisplayAlerts = False 'シート削除時のアラート停止 For Each Sh In Worksheets If InStr(Sh.Name, "統合") <> 0 Then Sh.Delete 'すでに統合シートが存在する場合は一旦削除 Next Application.DisplayAlerts = True 'シート削除時のアラート停止を解除 s = 1 '最大行を超えた場合次の統合シートを作成するための番号 Worksheets.Add Before:=Worksheets(s) '新規に統合シートを追加 ActiveSheet.Name = "統合" Set JoinSh = ActiveSheet '統合シートを変数に格納 For i = s + 1 To Worksheets.Count 'シートを統合シートの次~末尾までループ With Worksheets(i) '各月シート If i = 2 Then R = 1 '最初だけ項目も取得 Else R = 2 '最初以外は2行目から取得 End If MaxRow = .Cells(Rows.Count, 1).End(xlUp).Row '1列目で最終行を取得 MaxCol = .Cells(1, Columns.Count).End(xlToLeft).Column '1行目で最終列を取得 MyArray = Range(.Cells(R, 1), .Cells(MaxRow, MaxCol)) 'A1~データ末尾まで配列に格納 End With With JoinSh '統合シート MaxRow = .Cells(Rows.Count, 1).End(xlUp).Row '統合シートの1列目で最終行取得 If MaxRow + UBound(MyArray) > Rows.Count Then '最大行を超える場合の処理 s = s + 1 '統合シートの番号を加算 Worksheets.Add Before:=Worksheets(s) '新規に統合シートを追加 ActiveSheet.Name = "統合" & s '名前が同じにならないように番号を追加 Set JoinSh = ActiveSheet '統合シートを変数に格納 MaxRow = JoinSh.Cells(Rows.Count, 1).End(xlUp).Row '統合シートの1列目で最終行取得 End If If .Cells(1, 1) = "" Then '最初だけ1行目から貼り付け Range(.Cells(1, 1), .Cells(UBound(MyArray), MaxCol)) = MyArray Else '最初以外は最終行の次に貼り付け Range(.Cells(MaxRow + 1, 1), .Cells(MaxRow + UBound(MyArray), MaxCol)) = MyArray End If End With Next i End Sub ■3■最後に…、手作業で形式をコピーし、統合したファイルにペーストしています。 一度で解決するVBAをお教えいただけると本当に有難い限りです…。 お手数ですが、ご回答を心よりお待ちしております。 大変恐縮ですが、どうぞ宜しくお願い申し上げます。
質問日時: 2024/02/19 21:37 質問者: yuri_7
ベストアンサー
1
0
-
VBA ファイル名取得
ネットで調べて下記のVBAでファイル名が取得できるみたいなんですができません。何か間違っているところありますか?いろいろ調べて他のコードも試したのですができません。そもそもガイル名を取得するさいになにか特殊な設定等ありますか? Sub GetFileName() Dim FileName As String Dim Path As String Dim i As Long ' このファイルがあるフォルダーのパスを取得 Path = ThisWorkbook.Path ' フォルダ内のエクセルファイル名を取得して貼り付ける FileName = Dir(Panh & "\ファイル\" & "*.xlsx") 'ファイル名を各行の初期値を設定 i = 2 '該当するファイルがなくなるまでループ Do While FileName <> "" 'ファイル名をセルに入力 Cells(i, 1) = FileName '次のファイルを取得 FileName = Dir() 'iをカウントアップ i = i + 1 Loop End Sub
質問日時: 2024/02/18 13:24 質問者: ケイ0000
解決済
3
0
-
メールの件名をデコードしたい
メールをダウンロードしてテキストで見ると、 件名は、例えばこのように表示されます。 Subject: =?ISO-2022-JP?B?GyRCJCpPTSRTJEgkNE8iTW0bKEI=?= これをデコードすると、Subject:お詫びとご連絡 になります。(WEBに変換サイトあり) この作業をVBAでできないでしょうか?
質問日時: 2024/02/17 10:53 質問者: Ninjya2436
ベストアンサー
1
0
-
メールの件名のセットでエラーになる原因がわかりません
メールの件名をデコードしようとしていますが、 こんな簡単な操作にエラーがでてしまいます。 If Left(LineDATA1, 8) = "Subject:" Then SBJvalue1 = Mid(LineDATA1, 10, 100) End If Cells(rawi, 4) = SBJvalue1 ← ここで、以下のエラーで止まります。 実行時エラー1004 アプリケーションの定義エラーまたはオブジェクトの定義エラー 何が原因でしょうか?
質問日時: 2024/02/17 09:20 質問者: Ninjya2436
ベストアンサー
2
0
-
エクセルファイルのデータ転記について
画像の下のエクセルファイル(CSVと記載がありますがエクセルです)のデータを上の転記ファイルに転記させるマクロを作りました。赤の矢印のところに転記させるようにしています。 転記ファイルの黄色部の図番、品名、内製価格のデータは下のエクセルファイルにはありません。 この3つは現在、前回のデータをコピペしています。 例えば上の転記ファイルは下のエクセルファイルのデータを転記させた状態で、この時点では黄色部の部分は空白の状態です。 転記ファイルのC列のオ-ダ-NO. AA0000 D列のB00 E列の080 F列の枝番04-00 画像にはありませんが、もっと上のほうに枝番03-00という1個前のデータがあるので、03-00の時のデータをコピーして貼り付けをしています。この作業がなかなか大変なのでこちらも前のデータのものを拾って転記できないかと考えています。 考えているのが、AA0000 B00 080という番号を図番のAA0000B000801Bとマッチさせて転記できないかと。 画像のファイルだと次にAA0000 B00 080がきた場合枝番は06-00となりますが、図番、品名、内製価格の3つは前回の枝番のものと同じにしたいのです。 ややこしいのですが、枝番は数字だけではなくアルファベットの時もあります。AD-00など。その場合前回の枝番はAC-00。このように下へとどんどんデータが追加されていきます。 どういうやり方がよいのかは分かりませんが、自分で考えてみたコードだとうまくいきません。コードを貼り付けるので、いい方法があれば教えて頂きたいです。 図番、品名、内製価格のところのコードです。 分かりやすいように少し間隔を開けています。 ちなみに図番、品名、内製価格以外の転記はできています。 Sub 転記() Dim wb As Workbook Dim sh As Worksheet Dim fname As String Dim tbl As Variant Dim r1 As Long, r2 As Long Dim i As Long Application.ScreenUpdating = False Set sh = ActiveSheet With sh r1 = .Cells(Rows.Count, 2).End(xlUp).Row tbl = .Range("C3:K" & r1) End With fname = ThisWorkbook.Path & "\" & "注文.xlsx" Set wb = Workbooks.Open(fname) With wb.Worksheets(1) For r2 = 27 To .Cells(Rows.Count, 1).End(xlUp).Row r1 = r1 + 1 sh.Cells(r1, 2).Value = .Cells(r2, 8).Value '注番転記 sh.Cells(r1, 3).Value = .Cells(r2, 9).Value 'オ-ダ-NO.転記 sh.Cells(r1, 4).Value = .Cells(r2, 10).Value '部門転記 sh.Range(sh.Cells(r1, 5), sh.Cells(r1, 6)).NumberFormatLocal = "@" sh.Cells(r1, 5).Value = Format(.Cells(r2, 11).Value, "000") '製番転記 sh.Cells(r1, 6).Value = Format(.Cells(r2, 12).Value, "00") & "-" & Format(.Cells(r2, 13).Value, "00") '枝番転記 sh.Cells(r1, 9).Value = .Cells(r2, 17).Value '数量転記 sh.Range(sh.Cells(r1, 10), sh.Cells(r1, 11)).NumberFormatLocal = "#,##0" sh.Cells(r1, 10).Value = .Cells(r2, 16).Value '単価転記 sh.Cells(r1, 17).Value = .Cells(r2, 7).Value '発注日転記 sh.Cells(r1, 18).Value = .Cells(r2, 20).Value '納期転記 '図番,品名,内製価格 For i = 1 To UBound(tbl) If .Cells(r2, 9).Value = tbl(i, 1) And .Cells(r2, 10).Value = tbl(i, 2) _ And .Cells(r2, 11).Value = tbl(i, 3) Then sh.Cells(r1, 7).Value = tbl(i, 5) sh.Cells(r1, 8).Value = tbl(i, 6) sh.Cells(r1, 11).Value = tbl(i, 9) Exit For End If Next i 'メーカー Select Case .Cells(r2, 5).Value Case "CHUAN YAO MACHINERY CO.,LTD" sh.Cells(r1, 16).Value = "全曜機械" Case "ZEN MACHINERY CO.,LTD" sh.Cells(r1, 16).Value = "大成ハイテック" Case "MANUFACTURING(THAILAND)" sh.Cells(r1, 16).Value = "HMT" End Select Next r2 End With With sh End With Range("A1:A2000").EntireRow.Delete wb.Save wb.Close 'wb.Close 'Kill fname Application.ScreenUpdating = True End Sub どなたか知恵えを貸して下さい。 よろしくお願いします。
質問日時: 2024/02/17 02:10 質問者: Wrangleruk
ベストアンサー
2
0
-
VBA エクセルで1列で表示したい。
このマクロなんですが、Sent_88310.emlを1列で表示したいのですが、ここにあるように myFields = Split(inRec, ",") カンマで区切られて、2列になってしまいます1列にしたく、 いろいろ、やってみますが、構文エラーになったり、うまく動きません。 どんなふうに、修正したらいいのでしょうか? --------------------- Public Sub ReadCSV() 'CSVファイルの読み込み Dim n As Long Dim myFields As Variant Dim inRec As String Dim r As Long Dim c As Long n = FreeFile Open ThisWorkbook.Path & "\Sent_88310.eml" For Input As #n r = 1 Do While Not EOF(n) Line Input #n, inRec myFields = Split(inRec, ",") For c = 0 To UBound(myFields) Cells(r, c + 1).Value = myFields(c) Next c r = r + 1 Loop Close #n End Sub ---------------------------
質問日時: 2024/02/16 20:34 質問者: Ninjya2436
ベストアンサー
1
0
-
VBAで特定のシート以外のシート名を変更したい
VBA超ビギナーです。 ネットで調べて、「すべてのシート名を日付に変更する」まではできたのですが、「特定のシート(シート名「シート名変更」)を除外してシート名を変更する」にするにはどこをどう変更すればいいのかわかりません。 以下は現在組んでいるコードです。 どのように変更すればよいでしょうか? Sub シート名一括で変える() Dim Ws As Worksheet Dim D As Date '最初の日付 D = Range("D3").Value '全シートをループ For Each Ws In Worksheets 'シート名を変更する Ws.Name = Format(D, "m.d(aaa)") '日数にプラス1をする D = D + 1 Next Ws End Sub
質問日時: 2024/02/14 13:00 質問者: kkkkk_99
ベストアンサー
2
0
-
Outlookの「受信日時」「件名」「本文」などをVBAを使ってExcelに転記したい
Outlookの「受信日時」「件名」「本文」などをVBAを使ってExcelに転記したいのですが、下記のコードですと、古い受信日時から1件しか取得できません。 出来れば、「受信トレイ」や「移動」「下書」きなどの取得したいフォルダーを選択し、新しい日付けから、「受信日時」「件名」「本文」を一括で Excelに転記できるVBAコードに設定にして頂けると助かります。 よろしくお願いいたします。 VBAコードURL https://writening.net/page?NWK5ZZ
質問日時: 2024/02/11 00:46 質問者: ボアヒロ
ベストアンサー
1
1
-
マクロについて質問です。 セルの内容をクリアするコマンドボタン(AX) を作成しました。 指定範囲が
マクロについて質問です。 セルの内容をクリアするコマンドボタン(AX) を作成しました。 指定範囲が30個までなので、 ボタンが全部で4つあります。 これを1つにまとめて1度にすべてクリアしたいです。 やり方を教えてください。 お願いします。
質問日時: 2024/02/10 19:13 質問者: せえちゃん
解決済
1
0
-
Excel VBAで値を変えながら、pdf出力したい
いつもありがとうございますm(__)m 学生の成績個票をVBAを用いて、印刷しています。(以下のコードです) Sub 正方形長方形1_Click() a = Range("M2") b = Range("O2") For i = a To b Range("B2") = i Worksheets("印刷用1").PrintOut Next i End Sub ------------------------------------------------------------------------- 今度は、学生番号〇番~〇番の成績個票を、pdf出力したいのですが、どのようなコードをかけばいいのでしょうか? ちなみに、ひとつのファイルに出力したいです。 お詳しい方、宜しくお願い致します。
質問日時: 2024/02/10 10:46 質問者: mapmap1027
ベストアンサー
3
0
-
wordの文書内で上から順番に"有"、"無"などを走査し該当のキーワードがあったら丸で囲む、最終文字
wordの文書内で上から順番に"有"、"無"などを走査し該当のキーワードがあったら丸で囲む、最終文字列まで上から順番にメッセージボックスに任意のキーワードを入れ、既に丸がある所はスキップみたいなことをしたく下記のような形で組んでみたのですが、エラーとなり思ったように処理ができません。 コンパイルエラー箇所 Set rng = rng.Find(keyWord, After:=rng.End, LookAt:=wdWhole) 検索などしてみましたが、よく理解できるページも見つけられずです。 参考になるサイトやここが悪いというような助言をいただけます幸いです。 元のソース Sub AddCircleHighlight() Dim doc As Document Dim rng As Range Dim keyWord As Variant Dim shp As Shape Set doc = ActiveDocument ' "有"と"無"のリスト keyWord = Array("有", "無") For Each keyword In keyWord For Each rng In doc.StoryRanges Do Set rng = rng.Find(keyword, LookAt:=wdWhole) If Not rng Is Nothing Then ' 既に〇が付いている場合はスキップ If InStr(rng.Text, "〇" & keyword & "〇") = 0 Then Set shp = doc.Shapes.AddShape(msoShapeOval, rng.Information(wdHorizontalPositionRelativeToPage), _ rng.Information(wdVerticalPositionRelativeToPage), 15, 15) With shp .Fill.Visible = msoFalse .Line.Weight = 1 .Line.ForeColor.RGB = vbBlack End With rng.Collapse wdCollapseEnd End If Else Exit Do End If Loop Next rng Next keyword End Sub
質問日時: 2024/02/08 16:41 質問者: HS83als
解決済
1
0
-
Excel VBA マクロ シート名を変えずにA列にあるセル名の名前でファイルの分割をしたいです
大変お世話になっております。 以下のVBAですと、シート名がA列に入力されている文字と同様になってしまいます。 分割する元ファイルのシート名をそのまま残し、A列に入力されている文字にてファイルの名前を付け分割をしたいです。お手数ですが、修正をお願い申し上げます。 ご回答をお待ちしております。 どうぞ宜しくお願い申し上げます。 Sub MAIN() Dim TName, TX As Long With ThisWorkbook Set ws1 = .Sheets(1) .Sheets.Add after:=ws1 Set ws2 = ActiveSheet End With With ws1 .UsedRange.Columns("A").Copy ws2.Range("A1") End With ws2.Columns("A").RemoveDuplicates Columns:=1, Header:=xlYes '担当名を配列に格納 TName = Application.Intersect(ws2.UsedRange, ws2.UsedRange.Offset(1)).Value Application.DisplayAlerts = False ws2.Delete Set ws2 = Nothing Application.ScreenUpdating = False For TX = LBound(TName) To UBound(TName) Call SheetSPLIT(TName:=TName(TX, 1)) Next End Sub Private Sub SheetSPLIT(ByVal TName As String) Dim Wb2 As Workbook Dim ws2 As Worksheet, RX As Long 'Sheet1を複写→新しいブック ws1.Copy Set Wb2 = ActiveWorkbook Set ws2 = Wb2.Sheets(1) With ws2 .Name = TName If .AutoFilterMode Then .Range("A1").AutoFilter For RX = .Range("A" & .Rows.Count).End(xlUp).Row To 2 Step -1 If .Cells(RX, "A").Value <> TName Then .Rows(RX).Delete End If Next .Range("A1").AutoFilter field:=1 End With Wb2.SaveAs Filename:=ThisWorkbook.Path & "\" & TName & ".xlsX" Wb2.Close Set Wb2 = Nothing End Sub
質問日時: 2024/02/05 22:10 質問者: yuri_7
ベストアンサー
3
0
-
outlookの受信日時、本文などをExcelに転記したいのですが・・・
初期設定で、 VBAのツール→参照設定VBAProject→「Runtimescript Library」のライブラリにチェックがないのですが、Windows10 64ビット、 Excelのバージョンは、2010年なのですが、「Runtimescript Library」の参照項目はないのでしょうか? Microsoft Outlook 16.0 Object Libraryは、項目があり、チェックを入れられます。 どうぞよろしくお願い致します。
質問日時: 2024/02/05 20:35 質問者: ボアヒロ
ベストアンサー
2
0
-
Outlookの「受信日時」「送信者アドレス」「件名」「本文」の内容をExcelへの取り込み
Outlookの「受信日時」「送信者アドレス」「件名」「本文」の内容をExcelへ VBAで使って取り込みたいのですが、エラーが出てしまいます。 設定はOutlookとExcelとも、Microsoft office 16()object Libraryは チェックが入っております。 VBAの構文が間違っているのでしょうか? お分かりの方、宜しくお願い致します。 Sub GetMail0() Dim oApp As New Outlook.Application Dim oNs As Outlook.Namespace Set oNs = oApp.GetNamespace("MAPI") Dim oF As Folder Set oF = oNs.Folders("自分の@outlook.com").Folders("受信トレイ") Dim mailLists As Items Set mailLists = oF.Items mailLists.Sort "[ReceivedTime]", False Dim i As Long For i = 1 To 3 'mailLists.Count On Error Resume Next Cells(i + 1, "A").Value = mailLists.Item(i).ReceivedTime Cells(i + 1, "B").Value = mailLists.Item(i).SenderEmailAddress Cells(i + 1, "C").Value = mailLists.Item(i).Subject Cells(i + 1, "D").Value = mailLists.Item(i).Body Next i End Sub
質問日時: 2024/02/05 19:05 質問者: ボアヒロ
ベストアンサー
2
0
-
Excelのマクロ(VBA)は、同じソースで、WindowsとMacで動きますか?
表題の件、経験者の方、お教えください。 MacとWindowsのExcelファイルをハンドリングするのには、マクロ(VBA)より、Pythonの方がよいのでしょうか。これから、MacとWindowsで動くものの開発に取り掛かろうと考えております。スクレイピングとも連動させることもありえると思っております。 どうぞ、よろしくお願い申し上げます。
質問日時: 2024/02/05 17:59 質問者: hgama1024
ベストアンサー
1
0
-
VBA 指定した回数分、別シートにコピー
「作業1」シートより M~N列の11行以降が、コピー元。「L10」は、コピー回数。貼付け先が「作業2」シートになります。 例で画像を載せました。 関数で処理できますか。関数で処理できるのであれば、関数でやりたいです。 VBAの方が簡単であれば、どのように記述すればいいのか、教えてほしいです。 大変困っております。どうぞよろしくお願い致します。
質問日時: 2024/02/05 17:38 質問者: mptn
ベストアンサー
2
0
-
VBA
Sub CopyDataFromMultipleFolders() Application.ScreenUpdating = False Application.DisplayAlerts = False Dim folderPaths(1 To 2) As String Dim fileName As String Dim filePath As String Dim wbSource As Workbook Dim wsSource As Worksheet Dim targetSheet As Worksheet Dim targetRow As Integer Dim folderIndex As Integer ' 事前に指定された2つのフォルダのパス folderPaths(1) = "C:\Path\To\Your\Folder1" folderPaths(2) = "C:\Path\To\Your\Folder2" ' 対象セルの初期化 targetRow = 1 ' フォルダごとに処理を繰り返す For folderIndex = 1 To 2 ' 選択したフォルダ内の全てのエクセルを一つずつ開く fileName = Dir(folderPaths(folderIndex) & "\*.xls*") If fileName = "" Then MsgBox "指定されたフォルダにExcelファイルが見つかりませんでした。", vbExclamation Exit Sub End If ' ③ 開いたシート内のC2、C3、I3(またはJ3)セルをコピーして ④ 貼り付け Do While fileName <> "" ' ファイルのフルパスを取得 filePath = folderPaths(folderIndex) & "\" & fileName ' Excelファイルを開かずにデータをコピー Set wbSource = Workbooks.Open(filePath, UpdateLinks:=0, ReadOnly:=True) ' 対象となるシートを指定 Set targetSheet = ThisWorkbook.Sheets(folderIndex) ' ターゲットシートにヘッダーを書き込む If targetRow = 1 Then targetSheet.Range("A1").Value = "C2" targetSheet.Range("B1").Value = "C3" targetSheet.Range("C1").Value = IIf(folderIndex = 1, "I3", "J3") End If ' 対象セルの値をコピー For Each wsSource In wbSource.Sheets targetSheet.Range("A" & targetRow).Value = wsSource.Range("C2").Value targetSheet.Range("B" & targetRow).Value = wsSource.Range("C3").Value targetSheet.Range("C" & targetRow).Value = IIf(folderIndex = 1, wsSource.Range("I3").Value, wsSource.Range("J3").Value) ' 次の行に移動 targetRow = targetRow + 1 Next wsSource ' ファイルを閉じる wbSource.Close SaveChanges:=False ' 次のファイルを取得 fileName = Dir Loop Next folderIndex ' 画面更新および警告の表示を再開 Application.ScreenUpdating = True Application.DisplayAlerts = True MsgBox "データのコピーが完了しました。", vbInformation End Sub 上記のVBAでシート1、2それぞれ貼付けの際にa1セルから順に貼り付けたいのですがどこを修正すればいいでしょうか?
質問日時: 2024/02/03 22:51 質問者: ケイ0000
解決済
1
0
-
郵便番号検索APIにてget ElementByTagNameでうまくを取得できない
EXCEL VBAにてyahoo郵便番号検索APIから最寄り駅を取得しようとしています。 get ElementByTagName("station")で取得しようとしますが、取得されません。 *を指定すれば、全要素は取得してきます。 最終的にはStationのNameから都庁前と取得したいです。 そこまで知識がなく誰かご教授いただけると助かります。 よろしくお願いします。 https://developer.yahoo.co.jp/webapi/map/openlocalplatform/v1/zipcodesearch.html <Country> <Code>JP</Code> <Name>日本</Name> </Country> <Address>東京都新宿区西新宿2丁目8-1</Address> <GovernmentCode>13104</GovernmentCode> <AddressMatchingLevel>6</AddressMatchingLevel> <PostalName>東京都庁</PostalName> <Station> <Id>29213</Id> <SubId>2921301</SubId> <Name>都庁前</Name> <Railway>都営大江戸線</Railway> <Exit>A4</Exit> <ExitId>16417</ExitId> <Distance>167</Distance> <Time>2</Time> <Geometry> <Type>point</Type> <Coordinates>139.691368,35.690169</Coordinates> </Geometry> </Station> <Station> <Id>29085</Id> <SubId>2908501</SubId> <Name>西新宿</Name> <Railway>東京メトロ丸ノ内線</Railway> <Exit>2</Exit> <ExitId>15667</ExitId> <Distance>628</Distance> <Time>7</Time> <Geometry> <Type>point</Type> <Coordinates>139.692958,35.694213</Coordinates> </Geometry> </Station>
質問日時: 2024/01/31 23:25 質問者: アヤスカル1213
ベストアンサー
2
0
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
【Visual Basic(VBA)】に関するコラム/記事
-
賃貸で可能な古民家風レトロな部屋作りのコツ!改めて知る畳の高い機能性と魅力も紹介
生活スタイルが欧米化している昨今、和室よりも洋室の人気が高く、畳の需要が減ってきている。和風の民家が洋風にリノベーションされ売りに出されているのを目にしたことがある人も多いだろう。実際「教えて!goo」に...
-
メダロット:第240話「Vol.240※期間限定公開」
天才メダロッター六葉カガミの戦いを描く「メダロット再~リローデッド~」(漫画:伯林、監修:イマジニア)、20周年を迎えた『メダロット』が新たなストリーでココに再起動!!★全話無料で読める、週刊メダロット通信...
-
『保留にする勇気』を持つメリットとは?慣れない新環境で感じる気持ちのギャップ
春から新しい環境に身を置いている人も多いだろう。職場や学校に早く慣れ頑張りたいと思っていても、周囲と自分の気持ちにギャップがあり、ストレスを感じてしまうことがある。「教えて!goo」にも「保育士です。春か...
-
風水の観点で選ぶ観葉植物とは?置き場所や上げたい運気ごとの注意点を紹介!
飾ると部屋の雰囲気がぱっと明るくなる観葉植物。新年度を迎えたこの時期、気持ちも新たにインテリアに取り入れたいと思う人もいるだろう。せっかく飾るなら、運気もアップできれば一石二鳥だ。「教えて!goo」 にも...
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Vba 実数および実数タイプの変数に...
-
Excelのマクロについて教えてくださ...
-
VBA レジストリの値の読み方につい...
-
Excel VBA 定義されたプロージャ名...
-
Excel マクロについての相談
-
エクセルVBAについて
-
Vba SelStart、SelLen教えてくださ...
-
エクセルの合計を自動で表示させた...
-
Excelのマクロでワードのテキストボ...
-
Excelについて
-
2つのマクロでチェックボックスが連...
-
VBAに詳しい方教えてください。
-
エクセルのマクロについて教えてく...
-
エクセルのマクロについて教えてく...
-
VBAの質問になります Userform内で
-
VBA listBoxから
-
VBAで各列の"+"と"o"の合計数を数え...
-
VBA初心者 Ctrl+での操作、ボタンに...
-
VBA 複数条件の分岐処理の上手な方法
-
VB.net(VB)で、フォームにExcelファ...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Excel VBA 定義されたプロージャ名...
-
Excel-VBAのmsgBox()の不思議
-
【VBA】マクロの入ったファイルと同...
-
VBA 複数条件の分岐処理の上手な方法
-
現在のブックを閉じないで、マクロ...
-
VBAで各列の"+"と"o"の合計数を数え...
-
VBAに詳しい方教えてください。
-
エクセルのマクロについて教えてく...
-
エクセルのマクロについて教えてく...
-
エクセルのマクロについて教えてく...
-
エクセルのマクロについて教えてく...
-
エクセルのマクロについて教えてく...
-
エクセルのマクロについて教えてく...
-
ユーザーフォームに別シートからデ...
-
エクセルのマクロについて教えてく...
-
ExcelVBA シート名を複数セルから取...
-
エクセルのマクロについて教えてく...
-
VBA listBoxから
-
Excelのマクロについて教えてくださ...
-
エクセルのマクロについて教えてく...
おすすめ情報