| |
▼［名前なし］ さん：
今回、転記先は２４行目〜（ですよね？）ということがはじめてわかりました。
レイアウト要件については最初から、しっかりと説明いただかないと、回答側としては
実際のシートが見えず、不要なＱＡを繰り返すことになりますので、次回からは気をつけてくださいね。
まだレイアウト要件に不明なところもあります。
元シートのデータにはＥ列があるのですが、別シートには転記不要？
また、
>56,78,910,1112の2列を結合して文字が入ってます。
とのことでしたけど、11 12 (K,L) は結合じゃないようですし。
ということで、見えている要件だけでとりあえず。
なお、自動でセットする ○ の図形名として、Auto_Oval_行番号 と名前をセットしています。
Sub Sample()
Dim sp As Shape
Dim shT As Worksheet
Dim shF As Worksheet
Dim x As Long
Dim unitV As Variant
Dim c As Range
Dim z As Variant
Dim i As Long
Dim l As Double
Dim t As Double
Dim w As Double
Dim h As Double
Application.ScreenUpdating = False
Set shF = Sheets("Sheet1") '元シート
Set shT = Sheets("Sheet2") '別シート
x = shF.Range("A" & shF.Rows.Count).End(xlUp).Row - 101 + 1 '転記行数
If x < 1 Then
MsgBox "転記すべきデータがありません"
Exit Sub
End If
'前回の処理でセットされた楕円を削除
For Each sp In shT.Shapes
If sp.Name Like "Auto_Oval_*" Then sp.Delete
Next
'別シート転記欄のクリア
shT.Range("A24").MergeArea.Resize(shT.Rows.Count - 24 + 1).ClearContents
shT.Range("D24").Resize(shT.Rows.Count - 24 + 1).ClearContents
shT.Range("K24").Resize(shT.Rows.Count - 24 + 1).ClearContents
'元シートの情報を別シートに転記
shT.Range("A24").Resize(x).Value = shF.Range("A101").Resize(x).Value
shT.Range("D24").Resize(x).Value = shF.Range("B101").Resize(x).Value
shT.Range("K24").Resize(x).Value = shF.Range("D101").Resize(x).Value
'数量単位配列
unitV = Array(shT.Range("E24").Value, shT.Range("G24").Value, shT.Range("I24").Value)
i = 24 '転記開始行
'元シートのA列を抽出
For Each c In shF.Range("A101", shF.Range("A" & shF.Rows.Count).End(xlUp))
z = Application.Match(c.Offset(, 2).Value, unitV, 0)
If IsNumeric(z) Then
z = (z - 1) * 2 + 5 '転記先数量単位列
With shT.Cells(i, z).MergeArea
l = .Left
t = .Top
w = .Width
h = .Height
End With
With shT.Shapes.AddShape(msoShapeOval, l, t, w, h)
.Fill.Visible = msoFalse
.Name = "Auto_Oval_" & i
End With
End If
i = i + 1
Next
shT.Activate
Application.ScreenUpdating = True
MsgBox "転記終了"
End Sub
>▼UO3 さん：
>何度もすみません。ありがとうございます。
>
>１つのセルに１つ
>
>■ ｜ A ｜ B ｜ C ｜ D ｜ E ｜
>101｜明細1｜ 3 ｜ kg ｜ 100 ｜ 300 ｜
>
>こんな感じで入力されたデータを
>
> ｜ ABC ｜ D ｜ EF ｜ GH ｜ IJ ｜ k ｜
>24｜ 明細1｜ 3 ｜ t ｜ kg ｜リットル｜ 100｜
>（このときkgに丸がついている）
>
>こんな風に出力となります。すでにkgやリットルは書類の雛形に書いてあるため
>データを転載していく流れで特定の文字が入っていたらそれと同じ文字のセルを
>オートシェイプで丸をつけたいのです。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
