エクセルの学校：全文検索：Hyper Estraier： cell filename

Results of 1 - 1 of about 295 for cell filename (0.001 sec.)

cell (1170), filename (1984)

[[20200117173145]]: #score: 11157; @digest: c327d712fd396de0550bece85ef77cd3; @id: 81995; @mdate: 2020-01-18T04:54:57Z; @size: 13563; @type: text/plain; #keywords: letter (45818), タ*" (39991), mysheet (23774), 照デ (23025), 見セ (19082), includedocproperties (15818), xlqualitystandard (14877), srcsh (14007), quality (13773), openafterpublish (13279), ignoreprintareas (10897), xltypepdf (9815), exportasfixedformat (9298), 礼の (7103), 発見 (4599), 隠居 (3732), xlpastevalues (3312), operation (2712), pastespecial (2685), skipblanks (2673), メソ (2633), ソッ (2360), お礼 (2037), nothing (1934), worksheets (1865), ッド (1785), soulman (1641), filename (1589), レビ (1583), find (1459), paste (1404), activate (1315); 『最終行まで取得して、コピペを繰り返す（ペーストセルは固定）』（SARA）こんばんは。あらゆるものをひろって、記憶しながら行き詰っています。見ずらい形になっておりすみません。。今していることはアナログですm(__)m sheet2のデータをsheet1に貼り付けて、PDFにします。現在は、 sheet2のA列2行目の番号をコピーして、 sheet1値でE1に貼り付け sheet2のF列2行目をコピーして sheet1のB1に貼り付けて、PDFにして保存します。名前は、お礼の名前_番号.pdf希望です。これが10枚くらいだったらいいのですが、50枚となると辛くお力をお貸しいただけないでしょうか・・<m(__)m> ●（sheet1）letterシート・・・PDFを出力するデータ B1=お礼の名前 E1=番号 ↑文章が書いてあり、張り付けるセルは固定です。 ●（sheet2）○月〇日の参照データ・・・データが詰まっている A B C D E F G 1 番号継続待機備考備考2 お礼の名前対応 2 P511 マナ 3 P501 カナ 4 P101 モナ 5 P001 ミナ 6 P051 サナ ↑番号が重複することはありません。一旦自分でどんな形にしたいのか考えてみました。 2行目をコピーするというのは奇跡的に成功しました。これをループしたいのですが、私の知能ではたどり着けそうになく何か方法があれば教えていただきたいです。なんとなく、最終行を取得して、+1のような感じで、できないでしょうか。。。 n = Cells(Rows.Count, "A").End(xlUp).Row 下記作業を繰り返したいです。 --------------------------------------------- Cells.Find("お礼の名前").Select Selection.Offset(1, 0).Copy For Each mysheet In Worksheets If mysheet.Name Like "*letter*" Then mysheet.Activate Exit For End If Next Range("B1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False For Each mysheet In Worksheets If mysheet.Name Like "*○月〇日の参照データ*" Then mysheet.Activate Exit For End If Next Cells.Find("番号").Select Selection.Offset(1, 0).Copy For Each mysheet In Worksheets If mysheet.Name Like "*letter*" Then mysheet.Activate Exit For End If Next Range("E1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, fileName:= _ "¥pass¥" & Range("B1").Value & "_" & Range("E1").Value & ".pdf", Quality:=xlQualityStandard, _ IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _ True --------------------------------------------- ＜使用 Excel:Office365、使用 OS:Windows10 ＞ ---- こんばんは ^^ 回答ではありません気が付いた点だけで済みません。処理対象のワークシート【"*○月〇日の参照データ*" 】は何枚あるのでしょうかたくさんアドバイス、回答が有ると良いですね。でわでわ。。。m(_ _)m （隠居じーさん） 2020/01/17(金) 20:00 ---- 隠居じーさんご質問お気づきありがとうございます( ;∀;)また暖かい心遣いありがとうございます。【"*○月〇日の参照データ*" 】は1枚です! その日開くと当日の日付がはいります。【"*参照データ*" 】だけでよかったかもしれません。。よろしくお願いします。（SARA） 2020/01/17(金) 20:12 ---- こんばんは ^^ 様々な方法があろうかと存じますが一案です。ファイルパス等、解りませんので、PDF出力は、印刷プレビューに置き換えております。外していましたらお許しを。m(_ _)m Option Explicit Sub OneInstance() Dim Base Dim i As Long Dim Ws1 As Worksheet Dim WsS As Worksheet For i = Worksheets.Count To 1 Step -1 Select Case True Case Worksheets(i).Name Like "*letter*" Set Ws1 = Worksheets(i) Case Worksheets(i).Name Like "*参照データ*" Set WsS = Worksheets(i) End Select Next With WsS Base = .Cells(1).CurrentRegion End With With Ws1 For i = 2 To UBound(Base, 1) .Range("B1") = Base(i, 6) .Range("E1") = Base(i, 1) .PrintPreview Next End With Erase Base Set Ws1 = Nothing Set WsS = Nothing End Sub （隠居じーさん） 2020/01/17(金) 20:45 ---- こんばんは! 隠居じーさんさまから素敵な回答がついてますけど、、書いていたのでUpします。以下とても動くものではないですけど、、ちょっと書いてみました。書いていて思ったことは、 1.Select とか Activate は使わないでコードを書くこと 2.Rangeなどの前には必ずSheet名を指定すること 3.Find で検索した時もそうですけど、、必ずしもあるとは限りませんのでヒットしなかった場合のことも記述すること(よく私も抜けます_|￣|○）で、いきなりは難しそうなので先ずは日本語で、、それもご自身の言葉でストーリーを書くことそんなことを繰り返していくうちに自然とコードなんてのは書けるようになります。(多分(^^;弱気）参考にもならないでしょうけど、、良かったら参考にしてみて下さい。では、、では、、また、、 Option Explicit Sub kk() '変数を一つ宣言して Dim ws As Worksheet 'Sheet2をFindで検索 With Sheets("Sheet2") .Cells.Find("お礼の名前").Offset(1, 0).Copy End With '*letter* シートを wsにSetして For Each mysheet In Worksheets If mysheet.Name Like "*letter*" Then Set ws = mysheet Exit For End If Next 'wsがあれば実行なければ終了 If Not ws Is Nothing Then ws.Range("B1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False Else Exit Sub End If '*○月〇日の参照データ* シートをwsにSetして For Each mysheet In Worksheets If mysheet.Name Like "*○月〇日の参照データ*" Then Set ws = mysheet Exit For End If Next 'Sheet2の番号の一つ下をコピー With Sheets("Sheet2") .Cells.Find("番号").Offset(1, 0).Copy End With '*letter*シートをwsにSetして For Each mysheet In Worksheets If mysheet.Name Like "*letter*" Then Set ws = mysheet Exit For End If Next 'wsがあれば実行なければ終了 If Not ws Is Nothing Then .Range("E1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False Else Exit Sub End If 'wsシートをPdfに出力 With ws .ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ "¥pass¥" & .Range("B1").Value & "_" & .Range("E1").Value & ".pdf", _ Quality:=xlQualityStandard, _ IncludeDocProperties:=True, _ IgnorePrintAreas:=False, _ OpenAfterPublish:=True End With End Sub （SoulMan） 2020/01/17(金) 20:50 ---- 隠居じーさんさま!SoulManさま! 歓喜です( ;∀;) できました!! 最後の隠居じーさんの.PrintPreviewをSoulManさんがくれた下記を追加しました! .ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ "¥pass¥" & .Range("B1").Value & "_" & .Range("E1").Value & ".pdf", _ Quality:=xlQualityStandard, _ IncludeDocProperties:=True, _ IgnorePrintAreas:=False, _ OpenAfterPublish:=True まず、形が全く違うことに驚きました。そして、いただいた最初コメントいただきました隠居じーさんのマクロをぽちっと入れまして実行したら、何度プレビュー×押しても消えない(;´・ω・)となったのですが、それはプレビューだからということですね('◇')ゞ!!←プレビューって書いてくださっているのに、理解めっちゃ遅かったです。 SoulMan様ありがとうございます!正直宣言はあまりわかりませんでした(m´・ω・｀)m こちらも実行して、少しとまりましたので、デバッグさんが見つけてくれたところ追加してみましたが、私ではわかりませんでしたm(__)m シート名を記載することなど、メモつきでありがとうございます。 'wsがあれば実行なければ終了など、絶対いると思うので、頂戴させていただきます( ;∀;) 目の前にこんな素晴らしい方がいらっしゃったらなといつも思います( ;∀;) 最近IFをようやく理解したかな、理解できたかなという感じで。。ほんとにつなぎ合わせているので、マクロ理解者とは程遠いです。以前は、エクセルにマクロ記憶があるということを知り感激して、スクロールしすぎてなぜか入りきらないエラーみたいなのが出てしまったので、そこから少しずつ、何かコードらしきものを書くんだ!となっていますが、なんか急に難しいとなっています(*´▽｀*) 隠居じーさんさま、SoulManさま、ありがとうございましたm(__)m （SARA） 2020/01/17(金) 21:37 ---- 話が済んでいるようですが、いろいろ書いたので投稿しておきます。 ■1 とりあえず動いているとのことですが「〜Activate」とか「〜Select」していて、Selection○○やActive○○ありきのコードになっているので、まずここを改善してみましょう。 ■2 「Findメソッド」を使っておられますが、Findメソッドは目的のセルが見つからなかった場合、「Nothing」という特殊な値を返します。 http://officetanaka.net/excel/vba/cell/cell11.htm 「Nothing」はセルとしては扱えませんので、「Select、Offset、Copy」なども当然出来ません。したがって、「Nothing」じゃないときだけ処理をするというようにする必要があります。さらに、Findメソッドは通常操作の検索に相当しますが、いくつかの引数（オプションみたいなもの）で記述を省略した場合、前回値が承継されるものがあります。（前回とは、通常の検索、Findメソッドの実行どちらも対象になります）したがって、仮にキーワードが正しくても、検索に失敗する可能性があります。 https://www.moug.net/tech/exvba/0150111.html したがって、Findメソッドを使用されるなら (1) 引数はちゃんと書く (2) 見つかった時のみ(Nothingじゃなかった時のみ）処理されるようなコードにするというところに注意したほうがよいです。 ■3 PasteSpecialメソッドの引数について、規定値のものは省略が可能です。 ■4 コードは、sub〜end sub までが一塊なので、どうせ提示するなら全体を見せたほうがよいとおもいます。（もちろん個人情報などは隠して（適当なものに変えて）OKです） ■5 ＞【"*○月〇日の参照データ*" 】は1枚です! 全シートを巡回して、目的のシートを探している部分があります。この方法でも間違いではありませんが、別の方法もあります。 ■6 ということで、テストしてないですが、もともとのコードを整理・修正するとこんな感じ。（ループ処理にはしていません） Sub 整理() Dim srcSH As Worksheet Dim 発見セル As Range Dim お礼の名前 As String, 番号 As String Dim シート名 As String Const フォルダパス As String = "C:¥work¥" お礼の名前 = "マナ" 番号 = "P511" シート名 = "○月〇日の参照データ" '▼データシートを特定 On Error Resume Next Set srcSH = Worksheets(シート名) On Error GoTo 0 If srcSH Is Nothing Then MsgBox "【" & シート名 & "】が見つかりません" & vbkf & "処理を中止します" Exit Sub End If With srcSH '▼Findメソッドで検索 Set 発見セル = .Columns("F").Find(What:=お礼の名前, LookIn:=xlValues, LookAt:=xlWhole) '▼見つかったときだけ処理 If Not 発見セル Is Nothing Then 発見セル.Copy Worksheet("letter").Range("B1").PasteSpecial Paste:=xlPasteValues End If '▼考え方は上に同じ Set 発見セル = .Columns("B").Find(What:=お礼の名前, LookIn:=xlValues, LookAt:=xlWhole) If Not 発見セル Is Nothing Then 発見セル.Copy Worksheet("letter").Range("E1").PasteSpecial Paste:=xlPasteValues End If End With Worksheet("letter").ExportAsFixedFormat _ Type:=xlTypePDF, _ Filename:=フォルダパス & お礼の名前 & "_" & 番号 & ".pdf", _ Quality:=xlQualityStandard, _ IncludeDocProperties:=True, _ IgnorePrintAreas:=False, _ OpenAfterPublish:=True End Sub ■7 ループ処理したいということですが、6のコードをステップ実行して、どの命令がなにをやっているのか研究してみて、どの部分が次々と入れ替わったらよいのか考えてみてはどうでしょうか? ■8 ここまで書いておいてなんですが、「番号が重複することはありません。」なので、FINDメソッドで【検索】するんじゃなくて、フィルタオプションやオートフィルタなどで【抽出】するとか、【検索】などせずに、2〜最終行まで順番に処理すればいいだけのような気がします。（もこな2 ） 2020/01/18(土) 13:32 ---- ↑の■8の続き。推測があってるとすると、こんな感じ。 Sub 実験() Dim srcSH As Worksheet Dim シート名 As String Dim 行 As Long Const フォルダパス As String = "C:¥work¥" シート名 = Format(Date, "mm月dd日の参照データ") '▼データシートを特定 On Error Resume Next Set srcSH = Worksheets(シート名) On Error GoTo 0 If srcSH Is Nothing Then MsgBox "【" & シート名 & "】が見つかりません" & vbLf & "処理を中止します" Exit Sub End If '2〜A列最終行までをループ処理 With Worksheets("letter") For 行 = 2 To srcSH.Cells(srcSH.Rows.Count, "A").End(xlUp).Row .Range("B1").Value = srcSH.Cells(行, "F").Value .Range("E1").Value = srcSH.Cells(行, "A").Value .ExportAsFixedFormat _ Type:=xlTypePDF, _ Filename:=フォルダパス & .Range("B1").Value & "_" & .Range("E1").Value & ".pdf", _ Quality:=xlQualityStandard, _ IncludeDocProperties:=True, _ IgnorePrintAreas:=False, _ OpenAfterPublish:=True Next 行 End With End Sub （もこな2 ） 2020/01/18(土) 13:54 ...; https://www.excel.studio-kazu.jp/wiki/kazuwiki/202001/20200117173145.txt - [detail] - similar

PREV NEXT

訪問者：カウンタ