Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


9923 / 76734 ←次へ | 前へ→

【72366】Re:オートシェイプで丸を付ける
発言  UO3  - 12/7/21(土) 16:39 -

引用なし
パスワード
   ▼[名前なし] さん:

今回、転記先は24行目〜(ですよね?)ということがはじめてわかりました。
レイアウト要件については最初から、しっかりと説明いただかないと、回答側としては
実際のシートが見えず、不要なQAを繰り返すことになりますので、次回からは気をつけてくださいね。

まだレイアウト要件に不明なところもあります。
元シートのデータにはE列があるのですが、別シートには転記不要?
また、
>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 さん:
>何度もすみません。ありがとうございます。
>
>1つのセルに1つ
>
>■ | 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やリットルは書類の雛形に書いてあるため
>データを転載していく流れで特定の文字が入っていたらそれと同じ文字のセルを
>オートシェイプで丸をつけたいのです。

13 hits

【72359】オートシェイプで丸を付ける 橋矢上 12/7/20(金) 15:56 質問
【72360】Re:オートシェイプで丸を付ける UO3 12/7/20(金) 16:12 発言
【72361】Re:オートシェイプで丸を付ける 橋矢上 12/7/20(金) 16:47 発言
【72362】Re:オートシェイプで丸を付ける UO3 12/7/20(金) 17:28 発言
【72363】Re:オートシェイプで丸を付ける [名前なし] 12/7/20(金) 22:19 発言
【72364】Re:オートシェイプで丸を付ける UO3 12/7/21(土) 7:42 発言
【72365】Re:オートシェイプで丸を付ける [名前なし] 12/7/21(土) 13:09 発言
【72366】Re:オートシェイプで丸を付ける UO3 12/7/21(土) 16:39 発言
【72367】ありがとうございました。 [名前なし] 12/7/21(土) 19:12 お礼

9923 / 76734 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free