人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

Excelで、今A1からJ10までの100個のセルの中に、任意の自然数が入っています。
すべてのセルに入っているとは限らず、空白セルもあります。
また、入力されている任意の自然数はすべて異なります。

この条件のとき、VBAマクロを実行することにより、A13のセルから下のセルに向けて、
上記100個のセルの中に入力されている数値(空白セルは無視)を、小さい順に並べて表示
したいのです。
また、同様にB12のセルから右のセルに向けても同様に小さい順に並べて表示します。

たぶん簡単だと思うのですが、VBA作成の経験が皆無でして・・・。お恥ずかしい。
関数で実現可能かもしれませんが、今回は関数は使わないで、VBAのモジュール内容
を示していただけると嬉しいです。(シンプルな方が嬉しい)

余談ですが、今後このような細かい質問を何度かさせていただくかもしれません。
どうぞよろしくお願いします!!

●質問者: yoshifuku
●カテゴリ:コンピュータ 科学・統計資料
✍キーワード:A1 Excel VBA シンプル セル
○ 状態 :終了
└ 回答数 : 8/8件

▽最新の回答へ

1 ● garyo
●10ポイント

http://www.vector.co.jp/

Vector:ソフトウェア・ライブラリ&PCショップ

URLはダミーです。

動かなかったらごめんなさい。「”」等全角になっていたら半角にしてください。

Sub Macro1()

’ Macro1 Macro

’ マクロ記録日 : 2004/6/11 ユーザー名 :

Const X1 = 1

Const Y1 = 13

Const X2 = 2

Const Y2 = 12

Const MAX_X = 10

Const MAX_Y = 10

Dim x As Integer, y As Integer

For y = 1 To MAX_Y

For x = 1 To MAX_X

Cells((y - 1) * MAX_X + (x - 1) + Y1, X1) = Cells(y, x)

Cells(Y2, (x - 1) * MAX_Y + (y - 1) + X2) = Cells(y, x)

Next x

Next y

Range(”A13:A112”).Select

Selection.Sort Key1:=Range(”A13”), Order1:=xlAscending, Header:=xlGuess, _

OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _

:=xlPinYin, DataOption1:=xlSortNormal

Range(”B12:CW12”).Select

Selection.Sort Key1:=Range(”B12”), Order1:=xlAscending, Header:=xlGuess, _

OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight, SortMethod _

:=xlPinYin, DataOption1:=xlSortNormal

End Sub


2 ● moochin2004
●10ポイント

http://www.yahoo.com/

Yahoo!

URLはダミーです

下記のVBAでいかがでしょう?

EXCEL関数は使用せず、また配列や変数もプログラムが見づらくならない範囲で使用を控えました。

(少し冗長ですが...)

Dim i, j, k

Dim min, minx

’ すべてのセルを走査して空白以外のセルを横に並べる(仮置き)

k = 0 ’ 空白でないデータの個数カウント用変数

For i = 1 To 10

For j = 1 To 10

If Cells(j, i).Value <> ”” Then

Cells(12, 2 + k).Value = Cells(j, i).Value

k = k + 1

End If

Next

Next

’ 横に並べたセルを捜査し、小さい順に縦(A13〜)にコピー(移動)を行う

For i = 1 To k

’ 先頭のセルを仮の最小値とする

min = Cells(12, 2).Value

minx = 1 ’ 最小値のX座標

For j = 1 To k - i

’ 最小値を検索・更新する

If min >= Cells(12, 2 - 1 + j).Value Then

min = Cells(12, 2 - 1 + j).Value

minx = j

End If

Next

’ 最小値のセルを縦にコピーし

Cells(13 - 1 + i, 1).Value = Cells(12, 2 - 1 + minx).Value

’ コピー済みのデータを消去し左へつめる

Range(Cells(12, 2 - 1 + minx), Cells(12, 2 - 1 + k)).Value = Range(Cells(12, 2 - 1 + minx + 1), Cells(12, 2 - 1 + k + 1)).Value

Next

’ 縦に並べたセルを横方向(B12〜)にコピーする

For i = 1 To k

Cells(12, 2 - 1 + i) = Cells(13 - 1 + i, 1).Value

Next


3 ● hzk
●10ポイント

http://www.asahi-net.or.jp/~ef2o-inue/menu/menu04.html

Excelでお仕事!「VBA基本」メニュー

ソートを使うのは反則ですか?

一度値の入っているセルを抽出してソートしてみました。

Sub 並べ替え()

Dim t_rng, n_rng ’ 対象範囲, 現在処理中のセル

Dim max As Integer ’ 件数

Set t_rng = Range(”A1:J10”) ’ 範囲をA1からJ10にセット

max = 1 ’ 件数初期化

For Each n_rng In t_rng ’ 範囲(A1〜J10)をループ

If n_rng.Value = Empty Then ’ 現在のセルが空白

’ → なにもしない

Else ’ 何か入っている

Cells(max + 12, 1).Value = n_rng.Value ’ → A13 から縦にセット

Cells(12, max + 1).Value = n_rng.Value ’ B12 から横にセット

max = max + 1 ’ 件数 + 1

End If ’

Next n_rng ’ 繰り返し

’A13〜A112をソート

Range(”A13:A112”).Sort Key1:=Range(”A13”), _

Order1:=xlAscending, Header:=xlGuess, _

Orientation:=xlTopToBottom

’B12〜CW112をソート

Range(”B12:CW112”).Sort Key1:=Range(”B12”), _

Order1:=xlAscending, Header:=xlGuess, _

Orientation:=xlLeftToRight

End Sub


4 ● atsuosan
●10ポイント

http://homepage2.nifty.com/inform/vbdb/

VBでデータベース

URLはダミーです。

が、もしかすると役立つかもしれません。

以下、コードを書いてみました。

簡単なテストをして成功したので、とりあえず大丈夫だと思います。

もっとコードを短く出来るとは思いますが、自分で一番シンプルに考えられたので、これを書きます。

----------------------

Sub macro()

Dim array1() As Integer ’A1〜J10までの数字を直接入れる配列

Dim array2() As Integer ’並び替えた数字を入れる配列

Dim var As Variant ’セルに入っている値が数字かどうか調べる為の文字列

Dim n As Integer

Dim i As Integer

Dim j As Integer

For i = 1 To 10 ’1行〜10行まで繰り返し

For j = 1 To 10 ’A列〜J列まで繰り返し

var = Cells(i, j) ’(i,j)番目のセルを取る

If IsNumeric(var) Then

If var > 0 Then ’0以上の数値なら、配列に格納する

ReDim Preserve array1(n)

array1(n) = Cells(i, j)

n = n + 1

End If

End If

Next

Next

’A13から、下に向かってセルに代入していく

For i = 0 To UBound(array1)

Cells(i + 13, 1) = array1(i)

Next

’A13から、配列の数だけ下の部分までを選択して、並び替える

’(メニューの「データ」→「並び替え」を手動でマクロ記録したものです)

Range(”A13:A” & UBound(array1) + 13).Select

Selection.Sort Key1:=Range(”A13”), Order1:=xlAscending, Header:=xlGuess, _

OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _

:=xlPinYin, DataOption1:=xlSortNormal

’array2のサイズをarray1に合わせる

ReDim array2(UBound(array1))

’A13から、順にarray2に入れていく

For i = 0 To UBound(array2)

array2(i) = Cells(i + 13, 1)

Next

’b12から、横に書いていく

For i = 0 To UBound(array2)

Cells(12, i + 1) = array2(i)

Next

End Sub

----------------------

以上、分からない関数などがもしあれば、ヘルプで調べてみてください。


5 ● haradatoshihiro
●10ポイント

http://www.moug.net/

スキルアップ・問題解決はモーグにおまかせ! 情報コミュニティサイト モーグ

上記のページが参考になると思いますが、私のほうでも考えてみました。

このような感じでよいのでしょうか?

Sub sample()

’評価するセルの行数を「行」、列を「列」、評価された空白でないデータのカウント数を「数」という変数に設定します

Dim 行 As Integer

Dim 列 As Integer

Dim 数 As Integer

数 = 1

’A1からJ10までのデータを、セルが空白でなければA13から下に入れていきます

For 行 = 1 To 10

For 列 = 1 To 10

Cells(列, 行).Select

If Cells(列, 行) <> ”” Then

Cells(数 + 12, 1) = Cells(列, 行).Value

数 = 数 + 1

End If

Next

Next

’A列に入ったデータをソートします

Range(”A13”).Select

Range(Selection, Selection.End(xlDown)).Select

Selection.Sort Key1:=Range(”A13”), Order1:=xlAscending, Header:=xlGuess, _

OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _

:=xlPinYin

’ソートしたデータを行列を入れ替えてコピー&ペーストします

Selection.Copy

Range(”B12”).Select

Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _

, Transpose:=True

Application.CutCopyMode = False

Range(”A1”).Select

End Sub


1-5件表示/8件
4.前の5件|次5件6.
関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ