[[20151102132316]] 『改行して値の転記、図形作成』(けー) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『改行して値の転記、図形作成』(けー)

E列にある文字をキーにして、各行の値を変更したいです
E2(取り消し線有りの場合と空白は処理せず)に文字が存在する場合
E2の文字をB2に改行して追加転記、転記分だけ赤文字化、転記元は削除
F2の文字をC2に転記、更に赤文字化、転記元は削除
D2に「処理済み」のコメントを赤文字で記入
A2に赤の四角図形を追加し、中に赤文字でF1の数値を転記(全行2行分の高さがあり、下半分に追加図形を置きたい)
以上を1000行までVBAで処理したい

(表のスペース取りを修正しました)

	[A]	        [B]	         [C]          	[D]	        [E]	    [F]
[1]						                                     28
[2]	111      	りんご     	A倉庫	        未処理	       マグロ       1倉庫
[3]	222     	ばなな   	B倉庫	        未処理	       イワシ       2倉庫
[4]	333     	みかん   	C倉庫     	未処理	       ブリ(取消線) 3倉庫
[5]	444     	なし	        D倉庫	        未処理	                    4倉庫
[6]	555     	ぶどう   	E倉庫	        未処理	       ハマチ	    5倉庫

	[A]	        [B]	         [C]	          [D]	        [E]	    [F]
[1]						                                     28
[2]	111	       りんご    	1倉庫(赤)       処理済み(赤)		
	28(赤四角)     マグロ(改行赤)				
[3]	222	       ばなな    	2倉庫(赤)	処理済み(赤)		
	28(赤四角)     イワシ(改行赤)				
[4]	333            みかん    	C倉庫    	未処理         ブリ(取消線) 3倉庫
[5]	444	       なし	        D倉庫	        未処理	                    4倉庫
[6]	555	       ぶどう	                	処理済み(赤)		
	28(赤四角)     ハマチ(改行赤)	5倉庫(赤)			

< 使用 Excel:Excel2013、使用 OS:Windows7 >


A倉庫がどっか行ってしまい、更新後の表の意味がわかりません。

こうしたい、とだけありますが、貴方自身はそれを実現するために何かされていれば、それを開示してください。
ここまでコーディングしてみた、とか、図形のサイズは幾つにすると見栄えが良かった、とか。
四角の図形とおっしゃいますが、図形はセルの文字とは別物であり、扱いにくいです。■の文字では駄目なのですか?

それと、元が1行1データになっていて、列の意味も統一されているのに、変換するとこの規則が崩れてしまいます。
ソートもできなくなるし、データとしては汚くなってしまうので、元の形を崩さないように考え直しませんか?
ご要望通りにすると、新鮮な刺身をこんがり焼いて、ソースをかけて、残飯を作ってくれ、と言われているようです。
(???) 2015/11/02(月) 14:02


 新鮮な刺身をごった煮の雑炊にしてみました。
 特に、A列。2行分の高さのある行に、値が、どのように表示されているのかが見えず
 挿入した四角形の場所や大きさが、これでいいのかどうか、こちらではわかりませんが適当に。

 Sub Test()
    Dim c As Range

    For Each c In Range("A2", Range("A" & Rows.Count).End(xlUp))
        With c.EntireRow
            If Not IsEmpty(.Range("E1")) Then
                If .Range("E1").Font.Strikethrough = False Then
                    CombineWithRed .Range("B1"), .Range("E1")
                    CombineWithRed .Range("C1"), .Range("F1")
                    .Range("D1").Value = "処理済み"
                    .Range("D1").Font.Color = vbRed
                    c.Value = c.Value & vbLf
                    With ActiveSheet.Shapes.AddShape(msoShapeRectangle, c.Left, c.Top + c.Height / 2, c.Height, c.Height / 2)
                        .Fill.Visible = msoFalse
                        .Line.ForeColor.RGB = vbRed
                        .TextFrame2.TextRange.Characters.Text = Range("F1").Value
                        .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = vbRed
                    End With
                End If
            End If
        End With
    Next

 End Sub

 Private Sub CombineWithRed(r1 As Range, r2 As Range)
    Dim x As Long
    x = Len(r1)
    r1.Value = r1.Value & vbLf & r2.Value
    r1.Characters(Start:=x + 2, Length:=Len(r2)).Font.Color = vbRed
    r2.Clear
 End Sub

(β) 2015/11/02(月) 20:24


 追伸です。

 (???)さんご指摘通り、この整然とした元リストを置き換えてしまうと、後々、別の目的で利用しようとしたときに
 利用しづらくなります。

 やるとしても、別シートに展開したほうがいいと思いますね。

(β) 2015/11/02(月) 20:30


ほぼ希望通りの結果が得られ感謝いたします
また用意したデータ例があまり良くなかった様でご迷惑をおかけしてすみません。
ご指摘いただいた内容は検討課題としたいと思います。
(けー) 2015/11/03(火) 12:37

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.