[[20201103205137]]　『1セル内に違う色が付いた文字を削除したい』（ちびこ）　ページの最後に飛ぶ

『1セル内に違う色が付いた文字を削除したい』（ちびこ）

マクロでないと、出来そうにないかと思いご質問させて頂きました。
普段、マクロを使う事があっても、
構築などは、さっぱりわかりませんで・・・汗

・一つのセル内に緑と黒の文字が入っている。
・この黒文字だけを削除したい。

・黒文字はエクセル2010　カラーパレット内
　テーマの色、一番上、左から2番目の黒　です。

手入力でスペースを入れ、区切りを使おうかと思いましたが、
1100件程あるので、、、気が遠くなってしまいました・・
どうぞ宜しくお願い致します。

＜使用 Excel：Excel2010、使用 OS：Windows10 ＞

 以下のコード（プログラム）をどこかの標準モジュールにコピーして下さい。
 そして、
 ・処理したいセルを選択してから、
 ・test というマクロを実行してください。

 黒文字だけ消去します。
  （本当に黒文字を消すんですね。逆ではないですね。
   念のためバックアップをとって実行して下さい。
   マクロ実行すると、取り消して元に戻すことができません。）

 【参考コード】

 Dim re As Object

 Sub test()
     Dim c As Range
     Set re = CreateObject("VBScript.RegExp")
     re.Pattern = "<Font\s*html:Color=""#000000"">[\s\S]*?</Font>"
     re.Global = True

     Application.ScreenUpdating = False
     For Each c In Selection
         If IsNull(c.Font.Color) Then
             Call deleteBlackStrings(c)
         End If
     Next
     Application.ScreenUpdating = True
 End Sub

 Function deleteBlackStrings(c As Range)
     Dim s As String
     s = c.Value(xlRangeValueXMLSpreadsheet)
     c.Value(xlRangeValueXMLSpreadsheet) = re.Replace(s, "")
 End Function

 【備考】 
 [[20200513180814]]
 でマナさんに教わったものです。
 タグの一部に改行などが入ると失敗するかもしれません。

（γ） 2020/11/03(火) 21:40

補足です。
処理したいセルを選択して、と書きましたが、
もちろん、一つ一つ選択する必要はなく、まとめて選択できます。
　
また、フォント色が混在しているセルしか変更しません。
ですから、選択範囲中に、フォント色が混在していないセルが中にあっても、
それらは変更されないので、少し広めに選択しても問題ないと思います。
念のため。

なお、不測の事態も想定されるので、バックアップを取ってから
操作された方がよいと思います。

（γ） 2020/11/04(水) 11:08

Yさん　細かい補足まで、どうもありがとうございます！

早速、試してみましたが、黒文字の削除はできませんでした・・・汗

武上社会保険労務士事務所武上夏日

↑のように、一つのセル内に入っていて、
武上社会保険労務士事務所　が緑色、
武上夏日　が黒文字となってます、この名前だけ削除したいのですが、
名前なので、文字数もバラバラなのです。

Right関数でざっくりやってみようか？と考えておりました。
（ちびこ） 2020/11/04(水) 12:15

 そうですか、私の手元ではうまくいのですが、不思議ですね。不測の事態ですね。
 それでは、以下をためして、結果を教えてください。

 (1)まず、
  Function deleteBlackStrings(c As Range)
      Dim s As String
      s = c.Value(xlRangeValueXMLSpreadsheet)
      Debug.Print s                     '追加
      Debug.Print re.Replace(s, "")     '追加
      c.Value(xlRangeValueXMLSpreadsheet) = re.Replace(s, "")
  End Function
 と変更（2行を追加）して
 (2)
 そのセルだけを選択して、testを実行してみてください。

 イミディエイトウインドウに出力がありますので、
 それをそのままコピーペイストして教えてもらえますか？

（γ） 2020/11/04(水) 12:31

Yさん、どうもありがとうございます！
私の手順が違うかもしれません・・・

イミディエイトです！ご確認の程、どうぞ宜しくお願い致しますm(__)m

xmlns:o="urn:schemas-microsoft-com:office:office"

 xmlns:x="urn:schemas-microsoft-com:office:excel"
 xmlns:ss="urn:schemas-microsoft-com:office:spreadsheet"
 xmlns:html="http://www.w3.org/TR/REC-html40">
 <Styles>
  <Style ss:ID="Default" ss:Name="Normal">
   <Alignment ss:Vertical="Center"/>
   <Borders/>
   <Font ss:FontName="ＭＳ Ｐゴシック" x:CharSet="128" x:Family="Modern" ss:Size="11"
    ss:Color="#000000"/>
   <Interior/>
   <NumberFormat/>
   <Protection/>
  </Style>
  <Style ss:ID="s33">
   <Font ss:FontName="ＭＳ Ｐゴシック" x:CharSet="128" x:Family="Modern" ss:Size="11"
    ss:Color="#000000"/>
  </Style>
  <Style ss:ID="s34">
   <Alignment ss:Horizontal="Right" ss:Vertical="Center"/>
   <Font ss:FontName="ＭＳ Ｐゴシック" x:CharSet="128" x:Family="Modern" ss:Size="11"
    ss:Color="#000000"/>
  </Style>
  <Style ss:ID="s38">
   <Alignment ss:Horizontal="Right" ss:Vertical="Center" ss:WrapText="1"/>
   <Borders>
    <Border ss:Position="Top" ss:LineStyle="Continuous" ss:Weight="2"
     ss:Color="#CCCCCC"/>
   </Borders>
   <Font ss:FontName="メイリオ" x:CharSet="128" x:Family="Modern" ss:Size="13"
    ss:Color="#008080" ss:Bold="1"/>
   <Interior/>
   <NumberFormat/>
   <Protection/>
  </Style>
 </Styles>
 <Worksheet ss:Name="Sheet2">
  <Table ss:ExpandedColumnCount="1" ss:ExpandedRowCount="1" ss:StyleID="s33"
   ss:DefaultColumnWidth="54" ss:DefaultRowHeight="12.9375">
   <Column ss:StyleID="s34" ss:AutoFitWidth="0" ss:Width="388.5"/>
   <Row ss:AutoFitHeight="0">
    <Cell ss:StyleID="s38"><ss:Data ss:Type="String"
      xmlns="http://www.w3.org/TR/REC-html40"><B><Font html:Color="#008080">やなぎだ社会保険労務士事務所</Font></B><Font
       html:Color="#333333">柳田 紳吾</Font></ss:Data></Cell>
   </Row>
  </Table>
 </Worksheet>
</Workbook>

<?xml version="1.0"?>
<?mso-application progid="Excel.Sheet"?>
<Workbook xmlns="urn:schemas-microsoft-com:office:spreadsheet"

 xmlns:o="urn:schemas-microsoft-com:office:office"
 xmlns:x="urn:schemas-microsoft-com:office:excel"
 xmlns:ss="urn:schemas-microsoft-com:office:spreadsheet"
 xmlns:html="http://www.w3.org/TR/REC-html40">
 <Styles>
  <Style ss:ID="Default" ss:Name="Normal">
   <Alignment ss:Vertical="Center"/>
   <Borders/>
   <Font ss:FontName="ＭＳ Ｐゴシック" x:CharSet="128" x:Family="Modern" ss:Size="11"
    ss:Color="#000000"/>
   <Interior/>
   <NumberFormat/>
   <Protection/>
  </Style>
  <Style ss:ID="s33">
   <Font ss:FontName="ＭＳ Ｐゴシック" x:CharSet="128" x:Family="Modern" ss:Size="11"
    ss:Color="#000000"/>
  </Style>
  <Style ss:ID="s34">
   <Alignment ss:Horizontal="Right" ss:Vertical="Center"/>
   <Font ss:FontName="ＭＳ Ｐゴシック" x:CharSet="128" x:Family="Modern" ss:Size="11"
    ss:Color="#000000"/>
  </Style>
  <Style ss:ID="s38">
   <Alignment ss:Horizontal="Right" ss:Vertical="Center" ss:WrapText="1"/>
   <Borders>
    <Border ss:Position="Top" ss:LineStyle="Continuous" ss:Weight="2"
     ss:Color="#CCCCCC"/>
   </Borders>
   <Font ss:FontName="メイリオ" x:CharSet="128" x:Family="Modern" ss:Size="13"
    ss:Color="#008080" ss:Bold="1"/>
   <Interior/>
   <NumberFormat/>
   <Protection/>
  </Style>
 </Styles>
 <Worksheet ss:Name="Sheet2">
  <Table ss:ExpandedColumnCount="1" ss:ExpandedRowCount="1" ss:StyleID="s33"
   ss:DefaultColumnWidth="54" ss:DefaultRowHeight="12.9375">
   <Column ss:StyleID="s34" ss:AutoFitWidth="0" ss:Width="388.5"/>
   <Row ss:AutoFitHeight="0">
    <Cell ss:StyleID="s38"><ss:Data ss:Type="String"
      xmlns="http://www.w3.org/TR/REC-html40"><B><Font html:Color="#008080">やなぎだ社会保険労務士事務所</Font></B><Font
       html:Color="#333333">柳田 紳吾</Font></ss:Data></Cell>
   </Row>
  </Table>
 </Worksheet>
</Workbook>

<?xml version="1.0"?>
<?mso-application progid="Excel.Sheet"?>
<Workbook xmlns="urn:schemas-microsoft-com:office:spreadsheet"

 xmlns:o="urn:schemas-microsoft-com:office:office"
 xmlns:x="urn:schemas-microsoft-com:office:excel"
 xmlns:ss="urn:schemas-microsoft-com:office:spreadsheet"
 xmlns:html="http://www.w3.org/TR/REC-html40">
 <Styles>
  <Style ss:ID="Default" ss:Name="Normal">
   <Alignment ss:Vertical="Center"/>
   <Borders/>
   <Font ss:FontName="ＭＳ Ｐゴシック" x:CharSet="128" x:Family="Modern" ss:Size="11"
    ss:Color="#000000"/>
   <Interior/>
   <NumberFormat/>
   <Protection/>
  </Style>
  <Style ss:ID="s33">
   <Font ss:FontName="ＭＳ Ｐゴシック" x:CharSet="128" x:Family="Modern" ss:Size="11"
    ss:Color="#000000"/>
  </Style>
  <Style ss:ID="s34">
   <Alignment ss:Horizontal="Right" ss:Vertical="Center"/>
   <Font ss:FontName="ＭＳ Ｐゴシック" x:CharSet="128" x:Family="Modern" ss:Size="11"
    ss:Color="#000000"/>
  </Style>
  <Style ss:ID="s39">
   <Alignment ss:Horizontal="Right" ss:Vertical="Center" ss:WrapText="1"/>
   <Borders/>
   <Font ss:FontName="メイリオ" x:CharSet="128" x:Family="Modern" ss:Size="13"
    ss:Color="#008080" ss:Bold="1"/>
   <Interior/>
   <NumberFormat/>
   <Protection/>
  </Style>
 </Styles>
 <Worksheet ss:Name="Sheet2">
  <Table ss:ExpandedColumnCount="1" ss:ExpandedRowCount="1" ss:StyleID="s33"
   ss:DefaultColumnWidth="54" ss:DefaultRowHeight="12.9375">
   <Column ss:StyleID="s34" ss:AutoFitWidth="0" ss:Width="388.5"/>
   <Row ss:AutoFitHeight="0">
    <Cell ss:StyleID="s39"><ss:Data ss:Type="String"
      xmlns="http://www.w3.org/TR/REC-html40"><B><Font html:Color="#008080">小椋社会保険労務士事務所</Font></B><Font
       html:Color="#333333">小椋 一子</Font></ss:Data></Cell>
   </Row>
  </Table>
 </Worksheet>
</Workbook>

<?xml version="1.0"?>
<?mso-application progid="Excel.Sheet"?>
<Workbook xmlns="urn:schemas-microsoft-com:office:spreadsheet"

 xmlns:o="urn:schemas-microsoft-com:office:office"
 xmlns:x="urn:schemas-microsoft-com:office:excel"
 xmlns:ss="urn:schemas-microsoft-com:office:spreadsheet"
 xmlns:html="http://www.w3.org/TR/REC-html40">
 <Styles>
  <Style ss:ID="Default" ss:Name="Normal">
   <Alignment ss:Vertical="Center"/>
   <Borders/>
   <Font ss:FontName="ＭＳ Ｐゴシック" x:CharSet="128" x:Family="Modern" ss:Size="11"
    ss:Color="#000000"/>
   <Interior/>
   <NumberFormat/>
   <Protection/>
  </Style>
  <Style ss:ID="s33">
   <Font ss:FontName="ＭＳ Ｐゴシック" x:CharSet="128" x:Family="Modern" ss:Size="11"
    ss:Color="#000000"/>
  </Style>
  <Style ss:ID="s34">
   <Alignment ss:Horizontal="Right" ss:Vertical="Center"/>
   <Font ss:FontName="ＭＳ Ｐゴシック" x:CharSet="128" x:Family="Modern" ss:Size="11"
    ss:Color="#000000"/>
  </Style>
  <Style ss:ID="s39">
   <Alignment ss:Horizontal="Right" ss:Vertical="Center" ss:WrapText="1"/>
   <Borders/>
   <Font ss:FontName="メイリオ" x:CharSet="128" x:Family="Modern" ss:Size="13"
    ss:Color="#008080" ss:Bold="1"/>
   <Interior/>
   <NumberFormat/>
   <Protection/>
  </Style>
 </Styles>
 <Worksheet ss:Name="Sheet2">
  <Table ss:ExpandedColumnCount="1" ss:ExpandedRowCount="1" ss:StyleID="s33"
   ss:DefaultColumnWidth="54" ss:DefaultRowHeight="12.9375">
   <Column ss:StyleID="s34" ss:AutoFitWidth="0" ss:Width="388.5"/>
   <Row ss:AutoFitHeight="0">
    <Cell ss:StyleID="s39"><ss:Data ss:Type="String"
      xmlns="http://www.w3.org/TR/REC-html40"><B><Font html:Color="#008080">小椋社会保険労務士事務所</Font></B><Font
       html:Color="#333333">小椋 一子</Font></ss:Data></Cell>
   </Row>
  </Table>
 </Worksheet>
</Workbook>

（ちびこ） 2020/11/04(水) 13:12

 下から失礼しますが、いろが黒ではなく黒に見えるグレイ（＃333333）だったようですね。
（QS） 2020/11/04(水) 14:18

QSさん　ありがとうございます！

エクセルの自動　の色ではなかったので、

・黒文字はエクセル2010　カラーパレット内
　テーマの色、一番上、左から2番目の黒　です。

↑と書かせて頂きました。　という事は　#000000を　＃333333に置き換えれば！！

早速試してみます！！
（ちびこ） 2020/11/04(水) 14:37

やはり、できませんでしたが、

先程、スペース部分を削除してみたら、全部緑に変わってしまったので、、、
元々の色が＃333333では無いのかもしれませんね・・・。

大変お手数をお掛け致しまして、申し訳ございませんでした！！

毎日、リスト作りに追われていますので、
こちらのマクロについては、又使う機会があると思いますので、
是非、使わせて頂きます！！

今後共どうぞ宜しくお願い致しますm(__)m

（ちびこ） 2020/11/04(水) 15:14

 今回の場合、使用したい正規表現が
 <Font\s*html:Color=""#000000"">[\s\S]*?</Font>
 ではなく
 <Font\s*html:Color=""#333333"">.*?</Font>
 ではないでしょうか。
（QS） 2020/11/04(水) 15:28

ちょっと別のことをしていました。
QSさん、フォローありがとうございました。
私の意図は改行も対象に含める事です。
.*?ですと改行が弾かれますので。

スペース部分を削除とは
どういうことでしょうか？
半角のスペースに色が付いているんですか？
緑色の(つまり茶色以外の)文字が残るのはおかしく無いですね。
もう少し説明ください。
(外出先ですのでコードには触れませんが)

（γ） 2020/11/04(水) 16:13

茶色でなくグレーですか。
（γ） 2020/11/04(水) 16:16

 なるほど、余計なことを言ってしまったようですね。
 先のコメントは無視ください。
（QS） 2020/11/04(水) 16:18

Yさん　ありがとうございます！

最初にお話したように、区切りか、Right、Left関数でやってみようか？？と思い、
取り敢えず、スペース部分を削除してみた所、
一気に全部緑色に変わってしまいました・・・、ので、
元々の設定の色が黒っぽいものではなかったのかな？？と思いました。

こちら、原本は↓のサイトから抽出したものとなります。
https://www.sr-fukuoka.or.jp/consultants/search?freeword=&q%5Barea_id_in%5D%5B%5D=&q%5Barea_id_in%5D%5B%5D=&q%5Bfirst_name_cont%5D=&q%5Blast_name_cont%5D=&q%5Boffice_address_start%5D=&q%5Boffice_name_cont%5D=&q%5Btype_id_not_eq%5D=2&utf8=%E2%9C%93

・黒文字はエクセル2010　カラーパレット内
　テーマの色、一番上、左から2番目の黒　です。

度々、すみませんが、どうぞ宜しくお願い致します！
（ちびこ） 2020/11/04(水) 18:17

追記
上記、サイトを一括でエクセルに貼り付け、
事務所名だけフィルターで抽出したものです。

その際、手でスペースを削除していくと、
黒のままなのですが、置き換え機能で一括でスペースを外すと
ほぼ全部緑色になってしまいました。

（ちびこ） 2020/11/04(水) 18:26

話がかわってきているような？
区切り位置で、分割できないのですか。

（マナ） 2020/11/04(水) 18:58

試してみたら、#333333で、削除されましたが？

（マナ） 2020/11/04(水) 19:15

 ＞スペース部分を削除してみた所、
 ＞一気に全部緑色に変わってしまいました
 それをやると、当該スペースだけが削除されるだけでなく
 他の文字列の書式にも影響を及ぼすらしいので、それをやるのはマズそうです。

 本題ですが、XML文が途中で改行されるのが悪さをしているので

  <Font\s*html:Color=""#000000"">[\s\S]*?</Font>
 　　　　　　　　　　　　　↓
  <Font\s*html:Color=""#333333"">[\s\S]*?</Font>

 でカラー番号を変更すると共に、

   s = c.Value(xlRangeValueXMLSpreadsheet)
   s = Replace(s, vbCrLf, "")　　　　　　　　’←これを一文挿入して、改行を消去する

（半平太） 2020/11/04(水) 19:24

Yさん　QSさん　マナさん　半平太さん

大変ありがとうございました！！

先程、再度、Yさんの最初の式で#333333で試した所、無事削除できました！！

両方、何度も試して出来なかったのですが・・・原因は不明です、、、、汗
いつもと同じようにモジュールに書き込んでいたのですが、
きっと、私の手順のちょっとした事が違っていたのかもしれませんね・・。

大変お手数をお掛け致しまして申し訳ございませんでした、
＆大変ありがとうございました！

（ちびこ） 2020/11/04(水) 19:51

 あれー、旨くいったですか(それはそれで良かったですけども・・）

 　　　　　　　　　　　　      こう言うところで改行されるとマズいと思ったのですが(実際、旨くいかない例に遭遇した)
 　　　　　　　　　　　　　　 　↓
 re.Pattern = "<Font\s*html:Color=""#000000"">[\s\S]*?</Font>"

（半平太） 2020/11/04(水) 20:03

半平太さん　ありがとうございます！

Yさんより、改行などの注意のお気遣いがありましたので、
大丈夫だったようです！！

多分、1000件以上あったので、私のエクセルが参っていたのかもしれません・・。

わざわざ、ありがとうございました。

（ちびこ） 2020/11/04(水) 21:16

上手くいったようで何よりです。皆さんのフォロー/サポートのたまものです。
　
ところで、以下、念のためにコメントしておきます。
　
カラーパレットというのはいくらでもユーザー定義（変更）が可能です。
従って、"一番上の左から二つ目"といっても、特定の色を指定したことにはなりません。
　
ネットからコピーペイストしてできた文字のフォント色（#333333）は、
サイト側で決めたものですよね。
それがあなたの"一番上の左から二つ目"と本当に一致していますか？
（見た目が似ているだけではないですか？そんな気がします。
　もっとも、あなたがそのサイトの関係者で、自分が作成したものだ、
　というならそうかもしれませんが。）
　
私は、よもやそこまで修正はしていないだろうと、#000000と決め打ちしたのです。
　
いずれにしても、少しのことでも結果が得られないことは多いので、注意が必要です。

QSさん、また、
元々の手法にかかわった、マナさん、半平太さん、ありがとうございます。
（γ） 2020/11/04(水) 21:22

今回のように、縦一列で、セル内改行もないなら
Wordにコピペして、置換するのが簡単です。
↓は、カーソル位置の文字色と同じ色の文字を削除するマクロです。

 Sub test()
    Dim r As Range

    Set r = ActiveDocument.Tables(1).Range

    With r.Find
        .ClearFormatting
        .Font.Color = Selection.Font.Color
        .Execute Format:=True, Replace:=wdReplaceAll
    End With

 End Sub

こんな手順です。

 １）エクセルからワードにコピペ
 ２）削除したい文字位置にカーソルをおく
 ３）マクロ実行
 ４）ワードからエクセルにコピペ

（マナ） 2020/11/04(水) 21:37

Yさん　マナさん　ありがとうございます！

Yさん
今回のこの＃333333という色は、サイト作成者の任意のナンバーという事で、
承知致しました。

マナさん
ワードでの方法もあるんですね！
こちらの式もわざわざありがとうございます！

大変お勉強もさせて頂きました、
今月あと1万件程作成しなければならなったので、
大変助かりました！

（ちびこ） 2020/11/04(水) 21:53

 これからコピーするのであれば、コピー前に削除する方法も。

 ブックマークを作成して、URL の部分に下記を書き、先ほどのページを表示しておいてそのブックマーク
 をクリックすれば、名前が消えます。
 （ブックマークレットと検索すると、いろいろあると思います。）

 javascript:(function(){ var body = document.getElementsByTagName("body")[0]; body.innerHTML = body.innerHTML.replace(/<span>.*?<\/span><\/h3>/g,'<\/h3>');})();

 EXCEL の学校ですが、ご参考までに。
（QS） 2020/11/04(水) 22:00

QSさん　ありがとうございます！

早速試してみた所、目からウロコ！！でした、
サイトの情報は「完全に固定」だと思い込んでおりました・・・・。
こんな方法があっただなんて！

ホントに無知で・・・お恥ずかしながら、
ブックマークレットもお勉強させて頂きます！

重ね重ね、大変ありがとうございました。

（ちびこ） 2020/11/05(木) 12:46

コメント返信：

[ 一覧(最新更新順) ]

[[20201103205137]] 『1セル内に違う色が付いた文字を削除したい』（ちびこ） ページの最後に飛ぶ

[[20201103205137]]　『1セル内に違う色が付いた文字を削除したい』（ちびこ）　ページの最後に飛ぶ