HohoPapaのプロフィール

@HohoPapa HohoPapa
ありがとう数1,277
質問数1
回答数1,652
ベストアンサー数
454
ベストアンサー率
65%
お礼率
0%

  • 登録日2017/12/10
  • 性別男性
  • 都道府県栃木県
  • 報酬付き

    Excel テーブルからフォーマットに値を抽出

    Excelのデータテーブルからフォーマットに値を抽出して反映させるには。あるパトロール様式を作成しようとしています。 添付画像のようなイメージです。 ◇データテーブルのフィールド名と情報 PageNo. (パトロール記入シートのページ数 1日に1ページ) 日時 担当者 巡回時の注意点 ◇パトロールシートの様式 Sheet名をPageNo.の数字にし、データテーブルからINDEX関数で検索し、データテーブルにある日時・担当者・巡回時の注意点を抽出し反映させます。 このやり方で抽出は可能ですが、フォーマット(ここではパトロールシート)が巡回する日付分必要となり。操作が非常に重たくなり困っています。 印刷はPegeNo.のSheetを作業グループに選択して一括印刷しています。 VBAなどでPageNo.ごとの情報をフォーマットに反映させてページ一括でPDFや印刷プレビュー表示して印刷することは可能でしょうか。 現状のやり方でも印刷は可能ですが、動作が重くなり、途中でフリーズしてしまう場合があります。 詳しい方いましたらご教授ください。 よろしくお願いいたします。

  • 報酬付き

    エクセルの長文が入った結合セルを自動調整する方法

    金額等を書いた見積書作成でエクセルを利用しています。 症状などの症状を記入している結合されたセルの部分があるのですが、かなりの長文が入っている場合に、一番左の行の自動調節目的で行と行の間の線をダブルクリックしても、その長文の頭の1行部分しか表示できません。 その下の長文部分もきれいに表示してくれるような機能はエクセルにありますでしょうか? どうぞ、ご教示の程よろしくお願いします。

  • 報酬付き

    エクセルファイル 行列入れ替えたもの同時作成VBA

    あるxmlファイルを一旦テキストファイルにして そこから数値をエクセルファイルに移行して ひとつはM.xlsxとし それに続いて行列を入れ替えた エクセルファイルR.xlsxを 作りたいのですが M.xlsx R.xlsxのそれぞれを作るコードを 単純に 合体させただけでは どうも できません M.xlsxだけ また R.xlsxだけの 作成するコードは 出来たのですが それぞれ別のマクロとして実行することになります ひとつのマクロでM.xlsx R.xlsx同時に 作成するVBAコードは可能でしょうか 宜しくお願い致します ちなみに該当コードを単純化して 合体したのが以下のものです win10 office10 Sub 783縦() Dim FileName As Variant ChDir "\\DESKTOP-O5\f" FileName = Application.GetOpenFilename(FileFilter:="xmlファイル,*.xml") If FileName = False Then MsgBox "キャンセルされました" Exit Sub End If FileCopy FileName, Left(FileName, InStrRev(FileName, "\")) & "テキスト.txt" Const MyFile = "\\DESKTOP-O5\f\テキスト.txt" Const Key1 = "<Name>" Const Key2 = "</Name>" Const Key3 = "<NameKana>" Const Key4 = "</NameKana>" Const PutBokName = "M.xlsx" Dim buf As String Dim Len1 As Long Dim Len2 As Long Dim Pos1 As Long Dim Pos2 As Long Dim Len3 As Long Dim Len4 As Long Dim Pos3 As Long Dim Pos4 As Long Dim PutBook As Workbook With CreateObject("ADODB.Stream") .Charset = "UTF-8" .Open .LoadFromFile MyFile buf = .ReadText .Close End With Len1 = Len(Key1) Len2 = Len(Key2) Pos1 = InStr(buf, Key1) Pos2 = InStr(buf, Key2) Len3 = Len(Key3) Len4 = Len(Key4) Pos3 = InStr(buf, Key3) Pos4 = InStr(buf, Key4) Set PutBook = Workbooks.Add With PutBook.Sheets(1) .Cells(1, 1).Value = "氏名" .Cells(1, 2).Value = Mid(buf, Pos1 + Len1, Pos2 - (Pos1 + Len1)) .Cells(2, 1).Value = "氏名カナ" .Cells(2, 2).Value = Mid(buf, Pos3 + Len3, Pos4 - (Pos3 + Len3)) 'クリップボードをクリア Application.CutCopyMode = False PutBook.SaveAs ThisWorkbook.Path & "\" & PutBokName End With Const PutBokName = "R.xlsx" Dim buf As String Dim Len1 As Long Dim Len2 As Long Dim Pos1 As Long Dim Pos2 As Long Dim Len3 As Long Dim Len4 As Long Dim Pos3 As Long Dim Pos4 As Long Dim PutBook As Workbook With CreateObject("ADODB.Stream") .Charset = "UTF-8" .Open .LoadFromFile MyFile buf = .ReadText .Close End With Len1 = Len(Key1) Len2 = Len(Key2) Pos1 = InStr(buf, Key1) Pos2 = InStr(buf, Key2) Len3 = Len(Key3) Len4 = Len(Key4) Pos3 = InStr(buf, Key3) Pos4 = InStr(buf, Key4) Set PutBook = Workbooks.Add With PutBook.Sheets(1) .Cells(1, 1).Value = "氏名" .Cells(2, 1).Value = Mid(buf, Pos1 + Len1, Pos2 - (Pos1 + Len1)) .Cells(1, 2).Value = "氏名カナ" .Cells(2, 2).Value = Mid(buf, Pos3 + Len3, Pos4 - (Pos3 + Len3)) 'クリップボードをクリア Application.CutCopyMode = False PutBook.SaveAs ThisWorkbook.Path & "\" & PutBokName End With End Sub -------------------------------

  • 報酬付き

    エクセルファイル 行列入れ替えたもの同時作成VBA

    あるxmlファイルを一旦テキストファイルにして そこから数値をエクセルファイルに移行して ひとつはM.xlsxとし それに続いて行列を入れ替えた エクセルファイルR.xlsxを 作りたいのですが M.xlsx R.xlsxのそれぞれを作るコードを 単純に 合体させただけでは どうも できません M.xlsxだけ また R.xlsxだけの 作成するコードは 出来たのですが それぞれ別のマクロとして実行することになります ひとつのマクロでM.xlsx R.xlsx同時に 作成するVBAコードは可能でしょうか 宜しくお願い致します ちなみに該当コードを単純化して 合体したのが以下のものです win10 office10 Sub 783縦() Dim FileName As Variant ChDir "\\DESKTOP-O5\f" FileName = Application.GetOpenFilename(FileFilter:="xmlファイル,*.xml") If FileName = False Then MsgBox "キャンセルされました" Exit Sub End If FileCopy FileName, Left(FileName, InStrRev(FileName, "\")) & "テキスト.txt" Const MyFile = "\\DESKTOP-O5\f\テキスト.txt" Const Key1 = "<Name>" Const Key2 = "</Name>" Const Key3 = "<NameKana>" Const Key4 = "</NameKana>" Const PutBokName = "M.xlsx" Dim buf As String Dim Len1 As Long Dim Len2 As Long Dim Pos1 As Long Dim Pos2 As Long Dim Len3 As Long Dim Len4 As Long Dim Pos3 As Long Dim Pos4 As Long Dim PutBook As Workbook With CreateObject("ADODB.Stream") .Charset = "UTF-8" .Open .LoadFromFile MyFile buf = .ReadText .Close End With Len1 = Len(Key1) Len2 = Len(Key2) Pos1 = InStr(buf, Key1) Pos2 = InStr(buf, Key2) Len3 = Len(Key3) Len4 = Len(Key4) Pos3 = InStr(buf, Key3) Pos4 = InStr(buf, Key4) Set PutBook = Workbooks.Add With PutBook.Sheets(1) .Cells(1, 1).Value = "氏名" .Cells(1, 2).Value = Mid(buf, Pos1 + Len1, Pos2 - (Pos1 + Len1)) .Cells(2, 1).Value = "氏名カナ" .Cells(2, 2).Value = Mid(buf, Pos3 + Len3, Pos4 - (Pos3 + Len3)) 'クリップボードをクリア Application.CutCopyMode = False PutBook.SaveAs ThisWorkbook.Path & "\" & PutBokName End With Const PutBokName = "R.xlsx" Dim buf As String Dim Len1 As Long Dim Len2 As Long Dim Pos1 As Long Dim Pos2 As Long Dim Len3 As Long Dim Len4 As Long Dim Pos3 As Long Dim Pos4 As Long Dim PutBook As Workbook With CreateObject("ADODB.Stream") .Charset = "UTF-8" .Open .LoadFromFile MyFile buf = .ReadText .Close End With Len1 = Len(Key1) Len2 = Len(Key2) Pos1 = InStr(buf, Key1) Pos2 = InStr(buf, Key2) Len3 = Len(Key3) Len4 = Len(Key4) Pos3 = InStr(buf, Key3) Pos4 = InStr(buf, Key4) Set PutBook = Workbooks.Add With PutBook.Sheets(1) .Cells(1, 1).Value = "氏名" .Cells(2, 1).Value = Mid(buf, Pos1 + Len1, Pos2 - (Pos1 + Len1)) .Cells(1, 2).Value = "氏名カナ" .Cells(2, 2).Value = Mid(buf, Pos3 + Len3, Pos4 - (Pos3 + Len3)) 'クリップボードをクリア Application.CutCopyMode = False PutBook.SaveAs ThisWorkbook.Path & "\" & PutBokName End With End Sub -------------------------------

  • EXCEL2021で開けない...

    EXCEL2016で作成した外部データからピボットテーブルを作成したファイルをEXCEL2021で開くと[Microsoft][ODBC Driver Manager]データソース名および指定された既定のドライバーが見つかりません。となってしまいます。WINDOWS11です。どなたか解決策か何かヒントをお教えください。