• ベストアンサー

それぞれテキストファイに区切って出力

添付画像のような構成で  C列数値(D列の文字数の総計)を上から順番に合計して300を超えるとB列にその合計を書き出すようにしました。  (コード SumIfOver300) わかりやすいようにA列にそれぞれを塗分けしています。 1) 現在は、手動ですがこれをVBAで自動で処理したい。 (添付図は、3色ですが境目が解ればいいので2色でもOKです。) 2) 塗分け後に塗分けされたD列の部分を一つのテキスト群としてそれぞれ別ファイル(テキストファイル)に区切って出力したい。 添付図で言うといかのように出力  D2:D7  001_text.txt D8:D12 002_text.txt D13:D15 003_text.txt Sub SumIfOver300() Dim lastRow As Long Dim sum As Long Dim i As Long lastRow = Cells(Rows.Count, "C").End(xlUp).Row sum = 0 For i = 1 To lastRow sum = sum + Cells(i, "C").Value If sum > 300 Then Cells(i, "B").Value = sum sum = 0 End If Next i End Sub

質問者が選んだベストアンサー

  • ベストアンサー
  • kkkkkm
  • ベストアンサー率65% (1633/2477)
回答No.28

>  </i>は、 >   fileContent = Replace(fileContent, "/", "%EF%BC%8F") >   実際は、< / i>に先に変換されているので無駄なコードになっているようです。 上記を fileContent = Replace(fileContent, "</i>","") の後に実行すればいいのではないですか。 置換の順番は、文字数の多いものから先にするといいのではないでしょうか。 ただ 「%」は必ず一番最初に置換 は、あのグループの中で他の置換の結果に「%」が含まれるから、それを置換しないようにするためです。 > 事前にReplaceで削除しておきたいのですが > どのようなコードになりますか ? fileContent = Replace(fileContent, "</i>","") と同じようにすればいいと思います。

NuboChan
質問者

お礼

ありがとうございます。 難しく考えていました。 アドバイスのように削除記号をひとつずつコードで追加すれば良いのですね。 ( <*> のようにワイルドカード的な処理を想定していました。) 以下のコードに変更してしばらくテストしてみます。 fileContent = Replace(fileContent, "%", "%25") fileContent = Replace(fileContent, "<i>", "") fileContent = Replace(fileContent, "</i>", "") fileContent = Replace(fileContent, "<b>", "") fileContent = Replace(fileContent, "</b>", "") fileContent = Replace(fileContent, "<BR>", "") fileContent = Replace(fileContent, "#", "%23") fileContent = Replace(fileContent, "/", "%EF%BC%8F") pStr = Replace(Replace(Replace(fileContent, vbCr, "%0D"), vbLf, "%0A"), " ", "%20") ’---------------------------------------------

全文を見る
すると、全ての回答が全文表示されます。

その他の回答 (27)

  • kkkkkm
  • ベストアンサー率65% (1633/2477)
回答No.17

凄く単純な方法ですが、VBAで以下のようにするとDeepLで結果が出せます。 Omisoも最終結果はコピペだと思いますから、毎回コピペにはなりますが手動でやるよりは楽だと思います。 以下は3回のテスト版です。A1からA3まで英文を改行無しで入れておいて実行します。 一回ごとに「次の翻訳」が出るので大量にDeepLが出るのを防げます。 Sub Test() Dim i As Long Dim WSH Set WSH = CreateObject("Wscript.Shell") For i = 1 To 3 WSH.Run "https://www.deepl.com/translator#en/ja/" & Replace(Cells(i, "A"), " ", "%20") If MsgBox("次の翻訳", vbOKCancel) = vbCancel Then Exit For End If Next Set WSH = Nothing End Sub

全文を見る
すると、全ての回答が全文表示されます。
  • kkkkkm
  • ベストアンサー率65% (1633/2477)
回答No.16

> 「このサイトにアクセスできません。 > localhostで接続が拒否されました。」とエラー表示されてしまいます。 batを実行したままだと先に記載したようになると思います。 > 「Omiso翻訳」アイコンをクリックして数秒後にGoogleのポップアップウインドウに > 問題の上限表示が出ると参考画像の①のような水色のアイコンがでます。 はい、長文にしたら出るようになりました。ポップアップが出るのは遅いですが、他は同じです。 ちなみに、元の紹介ページの最後の方に記載されていた以下を試すとちゃんと実行されました。 >> https://www.deepl.com/translator#en/ja/This%20is%20a%20pen.を開くことで、DeepLによる翻訳を実行することができる。 実際 https://www.deepl.com/translator#en/ja/ の後ろに、長文でも英文を一行にしてスペースを%20に変換し、それを継ぎ足したリンクを実行するとDeepLが開いて翻訳してくれます。 多分、上記の方法をOmisoServer.ps1で行っているのだけど、最初の方にある$contextに値が入ってないみたいなので、受け渡しがうまくできていないのではないかと思います。

NuboChan
質問者

お礼

kkkkkmさん、No.15,No16において検証いただきありがとうございます。 DeepLの制限問題ではなくOmisoのスクリプトの問題で エラー表示等も私と同じ状況だと言う事がはっきりしました。 これ以上のスキルのない私の方でチェックできる事はなさそうなので omisoの利用は諦めます。 長々とお付き合い頂きありがとうございます。

全文を見る
すると、全ての回答が全文表示されます。
  • kkkkkm
  • ベストアンサー率65% (1633/2477)
回答No.15

同じエラーが出ました。 私が作った英文の一文が短すぎたのかもしれません。長い文章にしたらポップアップもエラーも同じ状態になりました。 DeepLでは上限に達していないことは確認しましたので、このスクリプトに問題がある(もしくは何かしらのセキュリティ)のかもしれません。

全文を見る
すると、全ての回答が全文表示されます。
  • kkkkkm
  • ベストアンサー率65% (1633/2477)
回答No.14

> 数秒後にGoogleにポップアップウインドウが出現して >  「このページの内容 >     DeepLの翻訳上限に達した可能性があります。」 > と表示される。 これは、DeepLからの応答がない時に「Omiso翻訳」アイコンのjavascriptが出しているメッセージだと思いますので、実際上限に達したかどうかは分からないと思います。 > cmd画面に新しく >  「null 配列にインデックスを付けることはできません。 OmisoServer.ps1の最初の方にあるlocalhostとかのURLをクリックすると callback({result: "", translationId: 0}); とchromeの新しいタブに表示され、PowerShellの方では同じエラーメッセージが出ますが、翻訳アイコンをクリックしたときには、ポップアップもchromeの表示もエラーも起きません。 「localhostにリクエストを出していないような感じ」 は OmisoServer.ps1の # requestが来たら翻訳処理をJobとして実行し、jobArrayに追加 if(($task.IsCompleted) -And ($jobArray.Count -lt $maxJob)){ 以降先に進まない状態です。「翻訳中」も出ないのでjavascriptがうまく動いてないのかもしれません。 NuboChanさんの場合は、メッセージが出たりエラーが出たりなので、私の実行時と同じ状況ではないと思います。

NuboChan
質問者

補足

話の内容がだんだん難しくなってき付いて行けていない状況です。 >OmisoServer.ps1の最初の方にあるlocalhostとかのURLをクリックすると >callback({result: "", translationId: 0}); >とchromeの新しいタブに表示され、 「OmisoServer.ps1の最初の方にあるlocalhostとかのURL」とは、 http://localhost:8000/? の事だと思いますが 私の環境では、このURLをクリックしても 「このサイトにアクセスできません。 localhostで接続が拒否されました。」とエラー表示されてしまいます。 http://127.0.0.1/Temporary_Listen_Addresses/ をクリックしても同じエラーが出ます。 >DeepLからの応答がない時に「Omiso翻訳」アイコンのjavascriptが出しているメッセージだと思いますので、 >実際上限に達したかどうかは分からないと思います。 なるほど、DeepLの上限問題とは関係ない可能性もあるのですね。 >「翻訳中」も出ないので 関係ないと思いますが、状況説明ですが、 「Omiso翻訳」アイコンをクリックして数秒後にGoogleのポップアップウインドウに 問題の上限表示が出ると参考画像の①のような水色のアイコンがでます。 ポップアップウインドウで「OK」すると 水色のアイコンがクリックできるようになり クリックすると①の画面が消えて②のように「翻訳中」が表示されます。 但し、「翻訳中」は表示だけのようで実際は何も処理されていないのか? 以後は何の変化もなりません。 (更なるエラー表示なども無い) >NuboChanさんの場合は、メッセージが出たりエラーが出たりなので、 >私の実行時と同じ状況ではないと思います。 11:50に記載した状況(メッセージ及びエラー表示)が毎回出るので kkkkkmさんと私の状況は、やはり違うようですね。 参考画像 https://imgur.com/JWiguv9

全文を見る
すると、全ての回答が全文表示されます。
  • kkkkkm
  • ベストアンサー率65% (1633/2477)
回答No.13

> その後、手順を「あーでもない、こうかな、これではどうか、それではこれで」的に色々模索しましたが > 結果的には翻訳が出来ませんでした。 残念ですね。私も試してみましたが、やり方が悪いのだと思いますが、ブックマークのリンクのやつクリックしても、localhostにリクエストを出していないような感じで無反応でした。

NuboChan
質問者

お礼

試しにダメ元でChromeのシークレットモードで試してみましたが、同じ状況です。 kkkkkmさんの言及されている「localhostにリクエストを出していないような感じ」とは、 私の場合で言うと、以下概略にあるcmd画面の事だと思います。 同じ状況ならomisoの使用は、DeepLの上限に無関係なので諦めます。 ’------------------------------------ Omisoのbat経由(起動)してPs1を起動。  cmd画面に「Translation Gummy Omiso Server is runnning....」と表示された状態のまま Googleで新しいシークレットモードを起動 翻訳すべきhtmlファイルをシークレット画面にD&D   Google画面に翻訳すべきテキストが表示される Googleに登録済みの「Omiso翻訳」アイコンをクリック 数秒後にGoogleにポップアップウインドウが出現して  「このページの内容     DeepLの翻訳上限に達した可能性があります。」 と表示される。 この時, cmd画面に新しく  「null 配列にインデックスを付けることはできません。    + CategoryInfo : InvalidOperation: (:) [], RuntimeException + FullyQualiedErrorId : NullAray + PSComputerName : localhost と表示されます。   (ポップアップウインドウとどちらが先に表示されるのかは瞬時なので不明)

全文を見る
すると、全ての回答が全文表示されます。
  • kkkkkm
  • ベストアンサー率65% (1633/2477)
回答No.12

「セキュリティ的にダウンロードができない場合」は、ファイルのダウンロードが許可されていないなどでZIPファイルがダウンロードできなければ、中身をリンク先からコピペしてファイルを自分で作ってねという事だと思います。 > 以下の使用方法は、翻訳したいテキストファイルをHTMLに変換する必要があるとの > kkkkkmさんのアドバイスがあるので実行まで至っていません。 「仕組み」のところで >> ブラウザ上ではブックマークレットで、<p>タグの中身を順にローカルサーバーにGetで送る。 というのがあったので <p> 元の文書 </p> (「<>」は半角で) として拡張子をhtmlにしてブラウザで開くのが >> コマンドプロンプトが開いたまま、翻訳したい論文ページをブラウザで開く。 の「翻訳したい論文ページをブラウザで開く」に該当すればと思ったのです。 実際は、「論文ページ」と同じつくりじゃないと駄目なのかもしれません。 また、以下のようにしてないといけないかもしれません。 <html> <head>文書のヘッダ部分</head>これはいらないかも <body> <p> 元の文書 </p> </body> </html> これでうまくいけば、テキストファイルに出力するときにタグを入れ込んで、拡張子をhtmlで保存するようにすればいいですね。 あと「順に~送る」とあったので元の文書を分割せずに、分けたい場所を<p></p>で囲んでやるといいのかもしれません。 以上、私が感じた部分です。全然勘違いの可能性も大ですが…。

NuboChan
質問者

お礼

kkkkkmさん、OMISOの利用方法の具体的な手順をおしえていただきありがとうございます。 その後、手順を「あーでもない、こうかな、これではどうか、それではこれで」的に色々模索しましたが 結果的には翻訳が出来ませんでした。 DeepLの仕様で、無料版(Pro版でない場合)では、  「テキストの翻訳」の場合登録ユーザーの場合1度に翻訳できる文字数が5000文字までと規制されています。 それとは別に「ファイルの翻訳」と言う機能が利用できるのですが、  これも無料版(Pro版でない場合)では、1か月に3ファイルまでの規制があります。    (1ファイルは10万語まで)   OMISOは、どうも「ファイルの翻訳」の方を利用していているようで  手順にしたがってテストで使用すると「Omiso翻訳」をクリックして数秒すると  「このページの内容     DeepLの翻訳上限に達した可能性があります。」 と表示されて門前払いされている状況です。 多分、今月数回「ファイルの翻訳」を利用したので上限に達したのだと思われます。 (参考にした、URL https://eigo-no-manma.com/deepl-subtitle-translation) 「テキストの翻訳」では、現在も上限以内なら問題なく利用できています。 OMISOを使って制限文字数(5000文字)以内のテキストファイルをOMISOで翻訳させる事を想定していたのですが 現状では、どうも無理そうです。 色々お世話になったのに残念な結果です。

全文を見る
すると、全ての回答が全文表示されます。
  • kkkkkm
  • ベストアンサー率65% (1633/2477)
回答No.11

> 突き詰めていくとコードで書式をテキストに変換する手段では > 思わぬところで不具合が発生しそうなので > 最初からA列を書式設定で文字列で登録していた方が良さそうですね。 どのようなデータが出てくるか考えが及ばないので、どんなデータでもOkとは言い難く、データが入っているセルのままどうにかするより、最初から空のセルを文字列で書式設定して、そこにデータを入れる方が間違いがなさそうですね。 > これを一つづつ手動でDeepLに処理させるのは厳しそうなので > やはり自動化が必要です。 先のリンク先を見てみたのですが、何となくですが、テキストデータをHTMLにして<p>タグで囲ってやるといけそうですね。

NuboChan
質問者

お礼

関連先(TranslationGummyOmiso)のURLをチェックいただきありがとうごじます。 >先のリンク先を見てみたのですが、 >何となくですが、テキストデータをHTMLにして<p>タグで囲ってやるといけそうですね。 「テキストデータをHTMLにして<p>タグで囲ってやるといけそうですね」 知識がなくどうやれば書き出したテキストファイルをOMISOに引き継いで翻訳させるかが良くわかりません。 初歩の初歩でしょうが、HTMLに変換する方法を教えてください。 ’-------------------------------------------------------- URLには、以下のように記載されています。 導入方法 「ここをクリック」してzipファイルをダウンロードし、解凍する。      --- 解凍までまで完了済み ブラウザで「このリンク」を開き、指示に従ってブックマークレットを登録する。      --- リンクをブックマークバーにドラッグ&ドロップしてGoogleに登録済み(omiso翻訳の表示確認済み) 以下の「セキュリティ的にダウンロードができない場合」は操作が理解できていないので行っていません。 セキュリティ的にダウンロードができない場合 「OmisoServer.ps1」,「StartOmisoServer.bat」を開く。 右上の「Raw」からプログラムを表示して、それぞれを別のメモ帳にコピペする。 それぞれを「OmisoServer.ps1」「StartOmisoServer.bat」の名前で保存する。 以下の使用方法は、翻訳したいテキストファイルをHTMLに変換する必要があるとの kkkkkmさんのアドバイスがあるので実行まで至っていません。 使用方法 ダウンロードしたディレクトリにある「StartOmisoServer.bat」をクリックすると、コマンドプロンプトが開く。 コマンドプロンプトが開いたまま、翻訳したい論文ページをブラウザで開く。 先ほど作成した「Omiso翻訳」ブックマークを開くと、10秒ちょっとで翻訳される。

全文を見る
すると、全ての回答が全文表示されます。
  • kkkkkm
  • ベストアンサー率65% (1633/2477)
回答No.10

もし、セルの値が日付だったり時刻だったりした場合は、現状では「文字列」に設定した途端にシリアル値がそのまま文字列になるので、その可能性があるのでしたら、以下にしておいた方が無難かもしれません。 現状は全てのセルでデータを再入力してますが、以下は「=」がある場合とない場合で分けています。 If cell.NumberFormat <> "@" Thenは、一応そのままにしてます。 For Each cell In Range("A1:A" & lastRow) If cell.NumberFormat <> "@" Then 'A列のセル書式設定が文字列で無い場合 tmp = cell.Text cell.NumberFormatLocal = "@" 'セルの書式をテキストに変更 If Left(cell.Formula, 1) = "=" Then 'セルのフォーミュラが"="で始まる場合 cell.Value = Mid(cell.Formula, 2) 'セルの値をフォーミュラの2番目以降の文字列に変更 Else cell.Value = tmp End If End If Next cell

NuboChan
質問者

お礼

kkkkkmさん、何度もコードの修正ありがとうございます。 気にかけていただいて点などを考慮すると 突き詰めていくとコードで書式をテキストに変換する手段では 思わぬところで不具合が発生しそうなので 最初からA列を書式設定で文字列で登録していた方が良さそうですね。 実際のDATAでテキストを分割したら連番が20個を超えてしまいました これを一つづつ手動でDeepLに処理させるのは厳しそうなので やはり自動化が必要です。

全文を見る
すると、全ての回答が全文表示されます。
  • imogasi
  • ベストアンサー率27% (4737/17068)
回答No.9

#3です。漏れを修正させてください。 A列セルに色付けするとき、(楽なので)Colorindexを使ってますが、この値は使えるのが35色(種)までなので、 If j>35 then j=1 end if を入れるべき、でした。

NuboChan
質問者

お礼

imogashiさん、興味を持っていただきありがとうございます。 >やって見ただけ(説明文の用意など)数時間必要だった)で、自分にとって新しいものは無いやり方となった。 貴重な時間を消費させるだけの結果になったようなのでごめんなさい。

全文を見る
すると、全ての回答が全文表示されます。
  • kkkkkm
  • ベストアンサー率65% (1633/2477)
回答No.8

以下の部分について書き忘れてました。 > If cell.NumberFormat <> "@" Then 'A列のセル書式設定が文字列で無い場合 この部分ですが、もし「-abc」が「=-abc」になっていて、今回のコードを実行する前に、そのままの状態で文字列に設定してしまった場合(手動で設定したなど)、データは「=-abc」のまま設定が文字列なので、今回のコードで「-abc」の文字列には変換されないと思います。 多分、そのままの状態で文字列に設定されていたというような事は無いと思いますが、気にしておいた方がいいと思います。

全文を見る
すると、全ての回答が全文表示されます。

関連するQ&A

  • エクセルVBAにてテキスト出力がうまくいきません

    エクセルシートの1列に以下のような文字列を打ち込みました。 - a aa aaa aaaa aaaaa - b bb bbb bbbb bbbbb - c cc ccc cccc ccccc - 「-」の2行後をテキストを出力した際のファイル名とし、ファイル名を含んだ次の「-」までの文字列をそのテキストの中に出力したいです。なお、全体の行数は分かっています。 例えば上の文字列に対して実行すると、 a.txt b.txt c.txt というファイルができ、それぞれの中には a aa aaa aaaa aaaaa などがそれぞれ出力されるようにしたいです。 Sub tepa() Dim strFilename As String Dim FileNumber As Integer Dim strREC As String j = 1 For i = 1 To 70 If Cells(i, 1) = "-" Then strFilename = Cells(i + 2, 1) & ".txt" Do While Cells(i + j, 1) <> "-" If i > 70 Then Exit Sub End If FileNumber = FreeFile strREC = Cells(i + j, 1) Open strFilename For Append As FileNumber Print #FileNumber, strREC Close j = j + 1 Loop End If i = i + j Next End Sub さきほど初めてVBAなるものを知り、見よう見まねで書いてみましたが・・・ループに陥ったりテキストファイルが1つめしか出力されなかったりとうまくいきません。 改善点など教えていただけたら嬉しいです。 よろしくお願いします。

  • EXCELVBAでデータをテキストファイルで出力したいと

    EXCELVBAでデータをテキストファイルで出力したいと考えています。 ***************************** 作成したVBA ***************************** Sub test_Click() Dim fNAME As String fNAME = "c:\test.txt" Open fNAME For Output As #1 i = 1 Print #1, "<test=" & Cells(1, i) & "," & Cells(2, i) & "," & Cells(3, i) & "," & Cells(4, i) & "," & Cells(5, i) & ">" Close #1 '閉じる End Sub ***************************** エクセルの値 ***************************** A列 1 2 3 4 5 ***************************** 出力されたテキストファイル ***************************** <test=1,2,3,4,5> このようになっていますが、 エクセルが A列 1 2 のように、2個しかないと、 <test=1,2,,,> のようになってしまいます。 <test=1,2> ↑のようになるように、エクセルの値に応じて、 「,」が出力しないようにしたいです。 どうしたらよいのでしょうか。 よろしくおねがいします。

  • 【VBA】"オブジェクトが必要です"メッセージ出力

    VBAを使用し、A列に日付、B列に数量、C列に単価、D列に金額を入力し、 数量*単価にて、金額を求めるVBAを作成しています。 そこまでは上手くいくのですが、D列で求めた金額を最終行で合計する事で 躓いてしまっています。 行は常に追加され可変の為、最終行を「Cells(Row.Count, 1).End(xlUp).Row」 にて引っ張ってこようと思っております。以下のようなVBAを記載しましたが、 「オブジェクトが必要です」とのメッセージがでて、処理が上手くいきません。 どのような問題があるのか、お分かりの方、ご回答頂けますと幸いです。 ■環境  Windows7  Excel2010 ■VBA Sub test() Dim i As Long Dim j As Long Dim k As Long For i = 2 To Cells(Row.Count, 1).End(xlUp).Row Cells(i, 4) = Cells(i, 2) * Cells(i, 3) Next j = Cells(Row.Count, 1).End(xlUp).Row + 1 k = Cells(j, 1).End(xlUp).Row Cells(j, 4) = WorksheetFunction.Sum(Cells(2, 4), Cells(k, 4)) End Sub

  • VBAで文字列のカウントがうまくいかない・・・です

    Dim cnt As Long Dim i As Long Dim lastRow As Long For i = 1 to 20 step 2 lastRow = Cells(65536, i).End(xlUP).Row cnt = WorksheetFunction.CountIf(ActiveSheet.Range(Cells(10, i),Cells(lastRow, i), "お世話になっております")cnt = cnt + cnt Next Excelのセルを1列ずつ飛ばして列に「お世話になっております」が含まれたら件数をカウントしています。 そのカウント数が何故かリセットされてしまいます。 カウント数を足していきたいのですが・・・考え方自体が違うのでしょうか?

  • VBAでDateaddの日付計算で困っていることがあるので助けていただけないでしょうか。よろしくお願いします。

    シート: A列には”注射”という文字を入れるようにします。 B列には1月1日から12月31日まで入っています。 C列はB列の90日後を入れるようにします。 D列はC列の3日前を入れます。・・・としたいのですがその3日の間A列に”注射”が入っていたらその日を入れずに3日前にしたいのです。 稼働日みたいな感じでしょうか・・・・ どうしたらよいでしょうか?お願いします。 例えば、B列の「1月1日」の90日後はC列「3月31日」でD列は通常「3月28日」が入っていますがB列「3月30日」の左のA列に”注射”があったらそこを無視して「3月27日」と入れたいのです。 Sub count() Dim i As Long Dim lastrow As Long lastrow = Range("B1").End(xlDown).Row For i = 1 To lastrow Cells(i, 3).Value = DateAdd("d", 90, Cells(i, 2).Value) Next For i = 1 To lastrow Cells(i, 4).Value = DateAdd("d", -3, Cells(i, 3).Value) Next End Sub 説明が下手なのでもしよかったら実際作ったものを見ていただいた方が分かるかもしれません。 http://briefcase.yahoo.co.jp/bc/robert_kubica_bmw/vwp2?.tok=bcf8oGbB4FXgt88k&.dir=/&.dnm=1count.xls&.src=bc

  • Excel VBAで文字列の部分一致の文字列を表示

    以前、こちらで頭5文字までの一致で文字列を表示するVBAを教えて頂きました。今回はFINDなどの部分一致での文字列を表示することをしたいのですが、ご教示いただけますと幸いです。 下記はSheet1のA3に文字を5文字以内いれるとSheet2のC列からピックアップしてSheet1のA列に文字列を表示する及びSheet2のB列のデータをSheet1のC列に表示させるVBAです。 Sub Test2() Dim Ws1 As Worksheet, Ws2 As Worksheet Dim SData As String, i As Long, VRet As Variant Dim c As Range, LastRow As Long Set Ws1 = Sheets("Sheet1") Set Ws2 = Sheets("Sheet2") SData = CStr(Ws1.Range("A3").Value) If SData = "" Then Exit Sub i = 5 LastRow = Ws1.Cells(Rows.Count, "A").End(xlUp).Row If LastRow < i Then LastRow = i End If Ws1.Range(Ws1.Cells(i, "A"), Ws1.Cells(LastRow, "C")).ClearContents With Ws2 For Each c In .Range(.Cells(1, "C"), .Cells(Rows.Count, "C").End(xlUp)) VRet = InStr(1, CStr(c.Value), SData, vbTextCompare) If VRet = 1 And Len(c.Value) >= 10 Then Ws1.Cells(i, "A").Resize(1, 2).Value = c.Resize(1, 2).Value 'とりあえずSheet2のB列のデータ(C列のデータに同期したデータ)をSheet1のC列に Ws1.Cells(i, "C").Value = .Cells(c.Row, "B").Value i = i + 1 End If Next End With End Sub 宜しくお願い致します。

  • VBAデータ元から新規ブックに出力

    現在のブック内に出力されるとメモリの都合上時間がかかりすぎますそこで新規ブック1個に出力する構文を教えていただきたいのですが、宜しくお願いします。 Sub 1111() Dim c As Range Dim i As Integer, LastRow As Long Dim NewSheetName As String, MatchFlag As Boolean Application.ScreenUpdating = False NewSheetName = "" With Sheets("データ元") For Each c In .Range(.Cells(3, "B"), .Cells(Rows.Count, "B").End(xlUp)) MatchFlag = False If NewSheetName <> Year(c.Value2) & "年" & Month(c.Value2) & "月" Then NewSheetName = Year(c.Value2) & "年" & Month(c.Value2) & "月" For i = 1 To Worksheets.Count If Sheets(i).Name = NewSheetName Then Sheets(i).Cells.ClearContents MatchFlag = True Exit For End If Next i If MatchFlag = False Then Worksheets.Add after:=Worksheets(Worksheets.Count) ActiveSheet.Name = NewSheetName End If End If LastRow = Sheets(NewSheetName).Cells(Rows.Count, "A").End(xlUp).Row Sheets(NewSheetName).Cells(LastRow + 1, "A").Resize(1, 6).Value = .Cells(c.Row, "A").Resize(1, 6).Value Sheets(NewSheetName).Columns("A:F").EntireColumn.AutoFit '↑A列からF列まで自動幅調整してます Next .Activate End With Application.ScreenUpdating = True MsgBox "終了しました", vbInformation End Sub

  • エクセル VBA テキストデータ書きだし

    お世話になっております。 エクセルのデータに記入したデータをテキストに書き出したいのですが、検索した結果、 A列だけテキスト化には成功したのですが、複数列(A-U)までコピーしたいのです。 シート名"メール" テキスト名"テキスト" 申し訳ございませんが、よろしくお願いします。 Sub テキスト() Dim StrFN As String StrFN = ActiveWorkbook.Path & "\テキスト.txt" Dim i As Long, LngLoop As Long Dim IntFlNo As Integer Worksheets("メール").Activate LngLoop = Range("a65536").End(xlUp).Row IntFlNo = FreeFile Open StrFN For Output As #IntFlNo For i = 1 To LngLoop Print #IntFlNo, Cells(i, "A") Next i Close #IntFlNo End Sub

  • マクロ 入力する文字に色を付けたい

    Sub CountUp(ByVal mCol1 As String, mCol2 As String) Dim LastRow1 As Long Dim LastRow2 As Long Dim mRow As Long With Sheets("プレーヤー") LastRow1 = .Cells(Rows.Count, mCol1).End(xlUp).Row LastRow2 = .Cells(Rows.Count, mCol2).End(xlUp).Row If LastRow1 > LastRow2 Then mRow = LastRow1 Else mRow = LastRow2 End If If LastRow1 = 1 Then LastRow1 = 2 End If .Cells(mRow + 1, mCol1).Value = .Cells(LastRow1, mCol1) + 1 End With End Sub このコードに文字の色の指定をしたいです Selection.Font.ColorIndex = 3を入れたら赤色文字で入力できるかなと思ったのですがうまくいきませんでした(エラーにはならないのですが、色が付かなかったです)

  • msgboxの表示

    A列の値とC列の値をMsgboxに表示するにはどうしたらいいのでしょうか?C列で一番高い商品とその品名A列を表示させたいのですが・・ Sub hinmei() Dim i As Long For i = 2 To Range("C65535").End(xlUp).Row Dim x As Long Dim a As Long x = Cells(i + 1, 5) If Cells(i, 5).Value < x Then a = x End If Next MsgBox a End Sub

専門家に質問してみよう