advanced help
per page, with , order by , clip by
Results of 1 - 1 of about 295 for cell filename (0.001 sec.)
cell (1170), filename (1984)
[[20230310011733]]
#score: 11157
@digest: 01ee980d3de22bd23fe63955112ff099
@id: 93722
@mdate: 2023-03-10T00:36:45Z
@size: 6489
@type: text/plain
#keywords: sheetnumber (78759), linkrange (67213), destsheet (50176), searchfolder (47158), searchpattern (39542), pasterange (35180), 場1 (12420), 「職 (11279), 場2 (10430), 計マ (10227), 職場 (7291), 定! (5334), 索フ (5131), 元フ (5128), ト先 (5064), タ1 (4936), cell (2816), file (2745), ト数 (2196), ス頂 (1993), displayalerts (1737), ル「 (1681), タブ (1606), 「デ (1558), ファ (1416), 宣言 (1322), の宣 (1314), リン (1259), 変数 (1254), ンク (1237), 集計 (1227), wb (1098)
『集計マクロがうまくいきません』(ねね)
作りたいコードに関してうまくできず、アドバイス頂ければ幸いです。 Sub 集計マクロ() Dim searchFolder As String Dim searchPattern As String Dim wb As Workbook Dim ws As Worksheet Dim pasteRange As Range Dim dataRange As Range Dim sheetNumber As Integer Dim linkRange As Range Dim cell As Range Dim destSheet As Worksheet ' 新しい変数の宣言 Dim i As Integer ' シート数を数えるための変数の宣言 ' 検索フォルダと検索パターンを設定 searchFolder = ThisWorkbook.Path & "¥" searchPattern = "*" & Range("設定!A1") & "*" ' フォルダ内の全てのファイルを検索 Dim file As Variant file = Dir(searchFolder & searchPattern) sheetNumber = 1 Application.DisplayAlerts = False ' 新しいシート名のための変数を初期化 i = 1 Do While file <> "" ' ファイルを開く Set wb = Workbooks.Open(fileName:=searchFolder & file, ReadOnly:=True, UpdateLinks:=False) For Each ws In wb.Worksheets If ws.Index >= 7 Then ' 7番目以降のタブのみ処理 ' データを貼り付けるシートを取得 On Error Resume Next Set destSheet = ThisWorkbook.Sheets("データ" & i) On Error GoTo 0 If destSheet Is Nothing Then MsgBox "シートが存在しません。" Exit Sub End If ' ペースト先範囲を指定 Set pasteRange = destSheet.Range("C" & sheetNumber + 35) ' リンクを貼る範囲を指定 Set linkRange = ws.Range("G64:AM64") ' リンクを貼る For Each cell In linkRange.Cells pasteRange.Offset(cell.Row - linkRange.Row, cell.Column - linkRange.Column).Formula = "='" & wb.Path & "¥[" & wb.Name & "]" & ws.Name & "'!" & cell.Address Next cell i = i + 1 ' シート数をカウントアップ End If Next ws wb.Close SaveChanges:=False file = Dir() sheetNumber = sheetNumber + 1 ' ペースト先のシートの行数を変更 Loop Application.DisplayAlerts = True MsgBox "データの取り込みが完了しました。" End Sub マクロ組むエクセルと同フォルダに7つ(現時点)の課名エクセルあります。あいまい検索で1つづつ開きデータ集計。1つ集計完了後、次ファイルを開き集計を繰り返します ※検索で開くエクセルFMは全て同じだがデータ値が違う。複数タブあり一番左のタブから右に7つ目以降のタブを集計対象。タブ例)「データ」「合計」「→」「職場1」「職場2」「職場3」...「職場7」「←」「その他」 集計は「職場1」〜「職場7」 ※ファイルにより増減 ※本当は「→ ←」内だけリンクしたいがそのように参照できない? そのため「右に7つ目以降のタブ」という指定で「職場1」〜「その他」まで 全部取ってしまおうと思います。 マクロ実行ファイル(※元ファイルとよぶ)に対象のタブC36:AI36以降の全セルリンク タブは複数、その中で「データ1」〜「データ7」あり 最初の集計対象ファイルは元ファイル「データ1」に入る 1.元ファイル「データ1」のC36:AI36に職場1のG84:AM84をリンク 2.元ファイル「データ1」のC37:AI37に職場2のG84:AM84をリンク 3.元ファイル「データ1」のC38:AI38に職場3のG84:AM84をリンク 上記の規則性 問題?@ 現コードは「2.」以降「データ2」のC37:AI37に職場2のG84:AM84がリンクになるってしまいます。 問題?A 上記「?@」がうまくいかないにしろ、次のファイルまで開きあいまい検索で引っかかるエクセルを順番に開き処理がますが、最初以外のデータはどこにもリンクされていません。 上書きされてしまうのならわかるのですが・・・。 アドバイス頂ければ幸いです。 宜しくお願い致します。 < 使用 Excel:Excel2016、使用 OS:Windows10 > ---- (1) 変数sheetNumber変数 の機能と 変数i の機能が不整合になっていると思います。 意味をよく考えてみて下さい。 (2)なお、 >※本当は「→ ←」内だけリンクしたいがそのように参照できない? のところは、例えば、 index1 = wb.Worksheets("→").Index index2 = wb.Worksheets("←").Index For k = index1 + 1 To index2 - 1 Set ws = wb.Worksheets(k) 以下略 こんな感じでよいのでは? (3) そもそもですが、インデントが正確についていないので、全体の構造がわかりにくいと思います。 例えば、こんな風にすると、もっと見やすくなると思いますよ。(内容は一切変えていません) Sub 集計マクロ() Dim searchFolder As String Dim searchPattern As String Dim wb As Workbook Dim ws As Worksheet Dim pasteRange As Range Dim dataRange As Range Dim sheetNumber As Integer Dim linkRange As Range Dim cell As Range Dim destSheet As Worksheet ' 新しい変数の宣言 Dim i As Integer ' シート数を数えるための変数の宣言 Dim file As Variant ' 検索フォルダと検索パターンを設定 searchFolder = ThisWorkbook.Path & "¥" searchPattern = "*" & Range("設定!A1") & "*" ' フォルダ内の全てのファイルを検索 file = Dir(searchFolder & searchPattern) sheetNumber = 1 Application.DisplayAlerts = False i = 1 Do While file <> "" Set wb = Workbooks.Open(Filename:=searchFolder & file, ReadOnly:=True, UpdateLinks:=False) For Each ws In wb.Worksheets If ws.Index >= 7 Then On Error Resume Next Set destSheet = ThisWorkbook.Sheets("データ" & i) On Error GoTo 0 If destSheet Is Nothing Then MsgBox "シートが存在しません。" Exit Sub End If Set pasteRange = destSheet.Range("C" & sheetNumber + 35) Set linkRange = ws.Range("G64:AM64") For Each cell In linkRange.Cells pasteRange.Offset(cell.Row - linkRange.Row, cell.Column - linkRange.Column).Formula _ = "='" & wb.Path & "¥[" & wb.Name & "]" & ws.Name & "'!" & cell.Address Next cell i = i + 1 ' シート数をカウントアップ End If Next ws wb.Close SaveChanges:=False file = Dir() sheetNumber = sheetNumber + 1 ' ペースト先のシートの行数を変更 Loop Application.DisplayAlerts = True MsgBox "データの取り込みが完了しました。" End Sub # マル付き数字は文字化けするので、ここでは使わないで下さい。 (abc) 2023/03/10(金) 06:03:04 ---- ご丁寧なご返信、アドバイスありがとうございます。 頂いた内容を確認し、コード修正にトライしてみたいと思います。 掲示板の使い方までわかっていなくて申し訳ございません。 しっかり覚えておきます。 まずはやってみます。 ありがとうございます (ねね) 2023/03/10(金) 09:36:45 ...
https://www.excel.studio-kazu.jp/wiki/kazuwiki/202303/20230310011733.txt - [detail] - similar
PREV NEXT
Powered by Hyper Estraier 1.4.13, with 97054 documents and 608269 words.

訪問者:カウンタValid HTML 4.01 Transitional