1)EXCELで作成した図の情報を集計したい。
EXCELでフロアのレイアウト図を作るとします。
その時図は既に別シートに用意されています。図を作成する時には部品(机の絵やキャビネットの絵)のシートよりコピーなどで作図用のシートにコピーし、作成します。
作図のシートで部品をいくつつかっているかの集計を行いたいのですが、可能でしょうか?
集計用のシートに結果がでるのでもいいですし、作図のシートに集計ボタンをつくり押すと集計結果が作図シートにでるのでもどちらでもよいです。
2)作図の微調整
上記で作図した部品を範囲指定をして、ぴたりと隣接させるような機能はありませんか?手で行うと微妙にずれてしまいます。
位置あわせは、左端の部品に合わせるとか、指定ができるとありがたいのですが・・
宜しくお願いします。
No.2ベストアンサー
- 回答日時:
各部品には名前をつけます。
(当然ついている?)それとシート『集計』を追加します。シート『集計』に部品個数を名前単位に合計して表示します。ショートカットキーに登録したほうがいいでしょう。ボタンを作るとボタンまで数えてしまうかもしれません。標準モジュールに貼り付けます。
'部品の個数を数える(Ctrl-Z)
Sub ShapesCount()
Dim objName() As String '部品の名前
Dim objCount() As Integer '部品の個数
Dim objKind As Integer '部品の種類(配列のインデックス)
Dim cot As Integer '部品カウンタ
Dim schKind As Integer '部品配列のインデックス
Dim k As Integer 'カウンタ
'アクティブシートの全図形を調べで部品ごとに集計する
For cot = 1 To ActiveSheet.Shapes.Count
schKind = 0
For k = 1 To objKind
'部品名配列のどれに該当するか探す
If ActiveSheet.Shapes(cot).Name = objName(k) Then
schKind = k '見つけたインデックス
Exit For
End If
Next
If schKind > 0 Then
'部品名配列に見つかれば加算する
objCount(schKind) = objCount(schKind) + 1
Else
'部品名配列になければ新しく配列を追加する
objKind = objKind + 1
ReDim Preserve objName(objKind) '再宣言
ReDim Preserve objCount(objKind) '再宣言
objName(objKind) = ActiveSheet.Shapes(cot).Name '部品名をセット
objCount(objKind) = 1 '個数は1
End If
Next
With Worksheets("集計") '『集計』シートに書き出す
.Columns("A:B").ClearContents '前回集計を消去
.Range("A1") = "部品" '表題
.Range("B1") = "個数" '表題
For cot = 1 To objKind
.Range("A" & cot + 1) = objName(cot) '部品名
.Range("B" & cot + 1) = objCount(cot) '部品の個数
Next
End With
End Sub
シート上の図形を揃える機能がないのも不思議ですね。
下は殆どお遊びマクロです。部品を並べたい位置に適当に配置して実行して下さい。
選択した部品の各右位置、横中央、左、下、縦中央、上位置の誤差を計算して一番誤差の少ない箇所を基準に自動的に揃えます。左端を揃えて縦に並べるなら、その感じが分かるようにテキトーに並べてマクロを実行して下さい。シート『集計』のD1セルにセットした値で図形間隔を指定できます。ゼロで密着します。フォームの上にコントロールを作ったときの、コントロールを揃える機能をシート上で行っているつもりです。標準モジュールに貼り付けます。(Excel97、2000で確認済みです)
それにしても長すぎる?いいのかな?
'基準位置を求めて図形を結合する(Ctrl-A)
Sub ShapeAutoSet()
Dim pot() As Double '図形の座標
Dim srt() As Double 'ソート用配列
Dim ord() As Double '図形の並び順
Dim sCot As Integer '図形の数
Dim s As Integer '図形のカウンタ
sCot = Selection.ShapeRange.Count
ReDim pot(sCot, 8) '右、横中央、左、下、縦中央、上の順
For s = 1 To sCot
With Selection.ShapeRange(s)
pot(s, 1) = .Left + .Width
pot(s, 2) = .Left + .Width / 2
pot(s, 3) = .Left
pot(s, 4) = .Top + .Height:
pot(s, 5) = .Top + .Height / 2
pot(s, 6) = .Top
pot(s, 7) = .Height
pot(s, 8) = .Width
End With
Next
'誤差を求め、最小の要素の位置で揃えるようにする
Dim gosa(6) As Double '右、横中央、左、下、縦中央、上を基準にした誤差
Dim j As Integer '基準を変える時のカウンタ
For j = 1 To 6
For s = 2 To sCot
gosa(j) = gosa(j) + (pot(s, j) - pot(1, j)) ^ 2
Next
Next
'最小の誤差は右、横中央、左、下、縦中央、上のどれ?
Dim idx As Integer '最小の誤差のインデックス
Dim Kijyun As Double '並べる順を決める要素
idx = 1
For s = 2 To 6
If gosa(s) < gosa(idx) Then
idx = s: Kijyun = 4: If idx >= 4 Then Kijyun = 1
End If
Next
'図形の処理順を決める
ReDim srt(sCot) 'ソート用配列
ReDim ord(sCot) '画面上の並び順
Dim wk1 As Double 'ワーク配列(値)
Dim wk2 As Integer 'ワーク配列(インデックス)
For s = 1 To sCot
ord(s) = s: srt(s) = pot(s, Kijyun)
Next
'処理順を決める
s = sCot
While s > 0
For j = 1 To s
If srt(j - 1) > srt(j) Then
wk1 = srt(j - 1): srt(j - 1) = srt(j): srt(j) = wk1
wk2 = ord(j - 1): ord(j - 1) = ord(j): ord(j) = wk2
End If
Next
s = s - 1
Wend
'密接して並べる
Dim joinTop As Double '図形を結合する上位置
Dim joinLeft As Double '図形を結合する左位置
Dim delta As Double '指定した間隔
delta = Worksheets("集計").Range("D1")
joinTop = pot(ord(1), 6)
joinLeft = pot(ord(1), 3)
For s = 2 To sCot
Select Case idx
Case 1, 2, 3 '上から下に並ぶ
joinTop = joinTop + pot(ord(s - 1), 7) + delta
joinLeft = pot(ord(1), 3) + (pot(ord(1), 8) - pot(ord(s), 8)) * (3 - idx) / 2
Case 4, 5, 6 '左から右に並ぶ
joinTop = pot(ord(1), 6) + (pot(ord(1), 7) - pot(ord(s), 7)) * (6 - idx) / 2
joinLeft = joinLeft + pot(ord(s - 1), 8) + delta
End Select
Selection.ShapeRange(ord(s)).Top = joinTop
Selection.ShapeRange(ord(s)).Left = joinLeft
Next
End Sub
No.1
- 回答日時:
> 記で作図した部品を範囲指定をして、ぴたりと隣接させるような機能はありませんか?
こちらの方だけ。
「図形描画」のツールバーに「図形の調整」というメニューがあります。ここの
「位置合わせ」をクリックして、「図形」が選択されている状態にしてください。
図形の移動やサイズの変更が、隣接している図形の座標をベースにした動作に
なります。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) Excel、同じフォルダ内のExcelファイルの特定シートのみを1つのファイルに集約したい 8 2022/09/07 15:12
- Excel(エクセル) VBA ふたつの同じ様式シートのセルをコピーしたい 2 2023/03/08 15:28
- Excel(エクセル) 【マクロ】同じフォルダ内にある複数ブックから1つのブック内の1シートにデータを集めたい 6 2022/09/28 18:16
- Visual Basic(VBA) コード名シートA列と集計シートA列のコードが一致したら、コード名シートA5からk12の範囲をコピーし 1 2022/08/29 23:46
- Excel(エクセル) 別シートに毎回異なるデータをコピーする 7 2022/06/24 09:02
- Visual Basic(VBA) VBAマクロでシートコピーした新シートにコピー元シートとの計算式の入れ方を教えて下さい。 5 2022/11/20 09:48
- Excel(エクセル) シートが違う2枚のエクセルシートにある数値を別シートにコピーしたい(VBA?) 8 2022/03/31 12:24
- Excel(エクセル) 【VBA】元のシート内の文字列を別シートと比較し、一致したら元のシートの別のセルへ転記する方法。 3 2023/03/23 17:30
- Excel(エクセル) Excelで特定の文字列を判定し計算する数式を教えて下さい。 1 2022/05/01 12:04
- Visual Basic(VBA) エクセルのマクロについて教えてください。 4 2023/05/24 08:33
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
SS400材とSPHC材の違い
-
TVが壊れ購入しようとしている...
-
『ワーク』を英訳すると?
-
散水用ホースの蛇口口金が抜け...
-
画像のような部品を探していま...
-
アクセスの初心者の質問です(...
-
製造中止後の部品供給期間
-
名前わからない部品しりたい
-
50年くらい使える安めのポスト...
-
中国は、似たような物を真似し...
-
日本語で何といいますか?
-
ねじを数える機器はないでしょ...
-
【VBA】元のシート内の文字列を...
-
家庭用エアコンの正面カバーの...
-
真鍮の材質について
-
NEFUSIとは何ですか?教えて下さい
-
電子部品と電気部品の違い
-
機嫌が悪い上司に報告
-
IATF16949で使われる用語に「チ...
-
ダイヤピンは英語でなんと言う...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
SS400材とSPHC材の違い
-
散水用ホースの蛇口口金が抜け...
-
VAIOのコンピュータの評判: 教...
-
『ワーク』を英訳すると?
-
電子部品と電気部品の違い
-
名前わからない部品しりたい
-
電子部品の略語
-
製造中止後の部品供給期間
-
アクセスの初心者の質問です(...
-
何年に渡ってメーカーは修理部...
-
取り合い寸法とはどういった所...
-
部品のカラーって?? 機械部品...
-
出荷時の数の数え間違いを防ぐ方法
-
画像のような部品を探していま...
-
家庭用エアコンの正面カバーの...
-
nominalは定格と訳してよいでし...
-
義務付けられた製品の部品供給年数
-
ガスコンロの発送方法を教えて...
-
ゴム硬さ ショアA90とA95の違...
-
【工場ライン作業】腕を素早く...
おすすめ情報