OKWAVEのAI「あい」が美容・健康の悩みに最適な回答をご提案!
-PR-
解決
済み

EXCELでこんなことはできますか?

  • 暇なときにでも
  • 質問No.209083
  • 閲覧数412
  • ありがとう数0
  • 気になる数0
  • 回答数2
  • コメント数0

お礼率 21% (42/200)

1)EXCELで作成した図の情報を集計したい。
  EXCELでフロアのレイアウト図を作るとします。
  その時図は既に別シートに用意されています。図を作成する時には部品(机の絵やキャビネットの絵)のシートよりコピーなどで作図用のシートにコピーし、作成します。
  作図のシートで部品をいくつつかっているかの集計を行いたいのですが、可能でしょうか?
  集計用のシートに結果がでるのでもいいですし、作図のシートに集計ボタンをつくり押すと集計結果が作図シートにでるのでもどちらでもよいです。

2)作図の微調整
  上記で作図した部品を範囲指定をして、ぴたりと隣接させるような機能はありませんか?手で行うと微妙にずれてしまいます。
  位置あわせは、左端の部品に合わせるとか、指定ができるとありがたいのですが・・
        宜しくお願いします。
通報する
  • 回答数2
  • 気になる
    質問をブックマークします。
    マイページでまとめて確認できます。

質問者が選んだベストアンサー

  • 回答No.2
レベル13

ベストアンサー率 68% (791/1163)

各部品には名前をつけます。(当然ついている?)それとシート『集計』を追加します。
シート『集計』に部品個数を名前単位に合計して表示します。ショートカットキーに登録したほうがいいでしょう。ボタンを作るとボタンまで数えてしまうかもしれません。標準モジュールに貼り付けます。

'部品の個数を数える(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
-PR-
-PR-

その他の回答 (全1件)

  • 回答No.1
レベル14

ベストアンサー率 50% (1122/2211)

> 記で作図した部品を範囲指定をして、ぴたりと隣接させるような機能はありませんか? こちらの方だけ。 「図形描画」のツールバーに「図形の調整」というメニューがあります。ここの 「位置合わせ」をクリックして、「図形」が選択されている状態にしてください。 図形の移動やサイズの変更が、隣接している図形の座標をベースにした動作に なります。
> 記で作図した部品を範囲指定をして、ぴたりと隣接させるような機能はありませんか?

こちらの方だけ。

「図形描画」のツールバーに「図形の調整」というメニューがあります。ここの
「位置合わせ」をクリックして、「図形」が選択されている状態にしてください。

図形の移動やサイズの変更が、隣接している図形の座標をベースにした動作に
なります。

このQ&Aのテーマ
このQ&Aで解決しましたか?
関連するQ&A
-PR-
-PR-
このやり方知ってる!同じこと困ったことある。経験を教えて!
このQ&Aにはまだコメントがありません。
あなたの思ったこと、知っていることをここにコメントしてみましょう。

その他の関連するQ&A、テーマをキーワードで探す

キーワードでQ&A、テーマを検索する
-PR-
-PR-
-PR-

特集


いま みんなが気になるQ&A

関連するQ&A

-PR-

ピックアップ

-PR-
ページ先頭へ