Results of 1 - 1 of about 295 for cell filename (0.001 sec.)
cell (1170), filename (1984)
- [[20211124063839]]
- #score: 11157
- @digest: a40fecb1eba19dd37695db1d6f49cfb0
- @id: 89691
- @mdate: 2021-11-24T03:45:50Z
- @size: 8315
- @type: text/plain
- #keywords: lsn (32741), 数ls (22736), tsvpath (22494), sfilepath (19644), rused (19277), 理列 (18620), 納fp (18175), savedata (15933), ブ区 (8808), 存→ (5914), 力() (5904), 成→ (5879), ク作 (5130), fpath (4204), desktop (3281), 出力 (3130), displayalerts (2172), users (1962), ー→ (1696), filesystemobject (1689), temp (1652), 格納 (1485), 水) (1450), 2021 (1434), activesheet (1378), double (1362), 規ブ (1344), ブッ (1246), 区切 (1183), close (1154), lastrow (1148), cells (1143)
- 『タブ区切り出力が処理できない』（kenN）
指定のセル範囲をタブ区切りでTEXTファイルに出力（保存）したいので 以下のようなコードを想定しましたが、空のTEXTしか保存されません。 1）多分、selectで指定したセル範囲がselectionで引き継がれないのが原因と思われます。 上手く引き継がれるようにするにはどうすれば良いですか ? 2）又、新しいブックを作成していますが ブックを作成せずに処理する方法があれば教えて下さい。 ----------------------------------- Sub タブ区切り出力() Dim fPath As String Dim LSN As Double '処理列の個数 LSN = Cells(Rows.Count, "A").End(xlUp).Row 'ファイル名を変数に格納 fPath = "C:¥Users¥Ken¥Desktop¥Test.txt" Application.DisplayAlerts = False '出力セルを選択 Range("D1", Cells(LSN, "F")).Select '新規ブック作成→出力するセルを新ブックのA1にコピー→保存→閉じる Workbooks.Add Selection.Copy ActiveSheet.Range("A1") ActiveWorkbook.SaveAs Filename:=fPath, FileFormat:=xlText ActiveWindow.Close Application.DisplayAlerts = True End Sub ＜ 使用 Excel:Office365、使用 OS:Windows10 ＞ ---- >selectionで引き継がれないのが原因と思われます。 Workbooks.Addで SelectionはActiveSheet.Range("A1")に変わったのではないのかな 予めコピーしておけばよいのでは Range("D1", Cells(LSN, "F")).Copy （どん） 2021/11/24(水) 06:52 ---- おはようございます ^^ 既に、ご案内ですが、簡単な修正案そのX。。。^^; 変数rを用意[レンジ型、もしくはバリアント] Range("D1", Cells(LSN, "F")).Select Selection.Copy ActiveSheet.Range("A1") ↓ Set r = Range("D1", Cells(LSN, "F")) r.Copy ActiveSheet.Range("A1") 2はこれでタブ区切りで出力されているなら[お望みの型式]。。。 よいのでは。。。(#^^#) ま 直接書き出しも可能ですが。少々煩雑に。。。← 私だけかも^^; m(__)m （隠居Z） 2021/11/24(水) 07:17 ---- >ブックを作成せずに処理する方法があれば教えて下さい。 Sheets("シート名").Copy で新規Bookにシートごとコピーされるので 後は不要なセルをクリアする （どん） 2021/11/24(水) 07:29 ---- 老婆心ながら。。。数式じゃないですよね。。。 Range("D1", Cells(LSN, "F")) の中身。。。^^; (￣▽￣)。。。m(_ _)m （隠居Z） 2021/11/24(水) 07:50 ---- ご参考。 https://www.google.com/search?q=vba+%E3%83%86%E3%82%AD%E3%82%B9%E3%83%88%E3%83%95%E3%82%A1%E3%82%A4%E3%83%AB+%E5%87%BA%E5%8A%9B&rlz=1C1GCEU_jaJP956JP957&oq=VBA%E3%80%80%E3%81%A6&aqs=chrome.4.69i57j0i4i512l6j69i61.9800j0j7&sourceid=chrome&ie=UTF-8 （ひまつぶし） 2021/11/24(水) 08:18 ---- 私なら 1.保存範囲を配列で取得 2.Openステートメントで保存 http://officetanaka.net/excel/vba/file/file08.htm アドバイス Selectに頼るのは止めましょう。 任意選択であれば有効ですが、本件ではデメリットしかないと思います。 （tkit） 2021/11/24(水) 08:36 ---- ネットを参考に以下を考えましたが 出力はされますが、テキストファイルの中身が 改行だけです。 出来る範囲で修正をお願いします。 Sub 出力() Dim rUsed As Range '// UsedRange Dim r As Range '// Cell Dim fs As New FileSystemObject '// FileSystemObject Dim ts As TextStream '// TextStream Dim sFilePath '// 出力ファイルパス Dim iRow '// 現在行 Dim s '// 出力文字列 Dim LSN As Double '処理列の個数 LSN = Cells(Rows.Count, "A").End(xlUp).Row '// ファイルパス=ブックと同じフォルダ+シート名+.txt sFilePath = "C:¥Users¥Ken¥Desktop¥Audacity.txt" '// FileSystemObjectで新規ファイル作成 Set ts = fs.CreateTextFile(sFilePath, True, False) '// ターゲットレンジを取得 Set rUsed = Range("D2", Cells(LSN, "F")) iRow = 0 '// 1セルずつループ For Each r In rUsed If iRow <> r.Row Then '// ループ初回時ではない場合 If r.Row <> rUsed.Row Or r.Column <> rUsed.Column Then '// 行が変わったため改行コードを付与 s = s & vbCrLf End If '// 行の先頭値を連結 s = s & r.Text Else '// タブ文字区切りで連結 s = s & vbTab & r.Text End If '// 現在行取得 iRow = r.Row Next '// セルの文字列が存在する場合 If s <> "" Then Call ts.WriteLine(s) ' Call ts.Write(s) ' Call ts.Write(vbCrLf) End If '// ファイルClose Call ts.Close End Sub （kenN） 2021/11/24(水) 08:40 ---- すいません。 以下の記事が先に投稿されるはずが、投稿されていませんでした。 以下に変更して上手く処理出来たと思ったのですが ヘッダー（見出し行）も出力されるので他の方法に変更中です。 Dim rng As Range Dim LSN As Double '処理列の個数 LSN = Cells(Rows.Count, "A").End(xlUp).Row '■現在開いているブック情報をファイル名にするため、変数に格納 fPath = "C:¥Users¥Nubo¥Desktop¥Audacity.txt" Application.DisplayAlerts = False '■現在選択しているセル情報をrngに格納 Set rng = Range("D2", Cells(LSN, "F")) '■新規ブック作成→rngをA1にコピー→TSV保存→CSV閉じる Workbooks.Add rng.Copy ActiveSheet.Range("A1") （kenN） 2021/11/24(水) 08:45 ---- 提案したので、コードを載せておきます。 Sub sample() 'パス指定 Dim tsvPath As String tsvPath = "D:¥TsvFile" & Format(Now(), "yyyymmddhhss") & ".tsv" 'データ取得 Dim lastRow As Long Dim saveData As Variant '▼冗長ですが、どのブック、どのシートかを意識付けすることが大事です With ActiveSheet lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row saveData = .Range("D1", .Cells(lastRow, "F")).Value End With 'データ整形 Dim arr() As String Dim temp() As String Dim i As Long Dim ii As Long arr = Split("") For i = LBound(saveData, 1) To UBound(saveData, 1) temp = Split("") For ii = LBound(saveData, 2) To UBound(saveData, 2) ReDim Preserve temp(UBound(temp) + 1) temp(UBound(temp)) = saveData(i, ii) Next ii ReDim Preserve arr(UBound(arr) + 1) arr(UBound(arr)) = Join(temp, vbTab) Next i 'データ保存 Open tsvPath For Output As #1 Print #1, Join(arr, vbCrLf) Close End Sub （tkit） 2021/11/24(水) 09:34 ---- tkitさん、回答ありがとうございます。 出力自体は問題なくできたのですが 配列を使用したコードは初心者には難解です。 また、セルの値が「秒」で表示を更に表示形式（FORMAT)で変更しています。 元の数値（秒）に戻すには、86400を掛け算する必要があるなど 複雑となるため今回は、以下を利用する事にしました。 Sub 出力() Dim fPath As String Dim fName As String Dim rng As Range Dim LSN As Double '処理列の個数 LSN = Cells(Rows.Count, "A").End(xlUp).Row '■現在開いているブック情報をファイル名にするため、変数に格納 fPath = "C:¥Users¥Ken¥Desktop¥test.txt" Application.DisplayAlerts = False '■現在選択しているセル情報をrngに格納 Set rng = Range("D1", Cells(LSN, "F")) '■新規ブック作成→rngをA1にコピー→TSV保存→CSV閉じる Workbooks.Add rng.Copy ActiveSheet.Range("A1") ActiveWorkbook.SaveAs Filename:=fPath, FileFormat:=xlText ActiveWindow.Close Application.DisplayAlerts = True End Sub （kenN） 2021/11/24(水) 10:30 ---- ＞複雑となるため今回は、以下を利用する事にしました。 提示の新たなブックを開かない方法として提案したので、 何を利用するかはお任せします。 ＞元の数値（秒）に戻すには、86400を掛け算する必要がある 取得時の.Valueを.Textにすればいいだけですよ。 （tkit） 2021/11/24(水) 11:04 ---- 既に提案のあるところですが、難しく考えず普通にテキストファイルに出力すればよいだけでは? Sub 研究用() Dim FN As Long, i As Long Stop 'ブレークポイントの代わり FN = FreeFile Open "C:¥Users¥Ken¥Desktop¥Test.txt" For Output As #FN With ActiveSheet For i = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row Print #FN, .Cells(i, "D").Text & vbTab & .Cells(i, "E").Text & vbTab & .Cells(i, "F").Text Next i End With Close #FN End Sub （もこな2） 2021/11/24(水) 12:45... - https://www.excel.studio-kazu.jp/wiki/kazuwiki/202111/20211124063839.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97054 documents and 608269 words.
訪問者：