Excelで、今A1からJ10までの100個のセルの中に、任意の自然数が入っています。

すべてのセルに入っているとは限らず、空白セルもあります。
また、入力されている任意の自然数はすべて異なります。

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

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

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

回答の条件
  • URL必須
  • 1人2回まで
  • 登録:2004/06/11 21:55:24
  • 終了:--

回答(8件)

id:garyo No.1

garyo回答回数1782ベストアンサー獲得回数962004/06/12 00:24:12

ポイント10pt

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

id:moochin2004 No.2

moochin2004回答回数36ベストアンサー獲得回数02004/06/12 00:59:28

ポイント10pt

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

id:hzk No.3

hzk回答回数77ベストアンサー獲得回数02004/06/12 01:44:56

ポイント10pt

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

id:atsuosan No.4

atsuosan回答回数46ベストアンサー獲得回数02004/06/12 09:13:35

ポイント10pt

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

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

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

id:haradatoshihiro No.5

haradatoshihiro回答回数1ベストアンサー獲得回数02004/06/12 19:57:12

ポイント10pt

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

id:nkysn No.6

nkysn回答回数10ベストアンサー獲得回数02004/06/11 22:39:04

ポイント20pt

http://www.hatena.ne.jp/1086958524

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

汎用性ありませんがどうでしょうか?

excel2002で作りました。

Sub mtrx()

Dim r, c, i As Integer

i = 13

For r = 1 To 10

For c = 1 To 10

If Cells(r, c).Value <> Empty Then

Cells(i, 1).Value = Cells(r, c).Value

i = i + 1

End If

Next c

Next r

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, DataOption1:=xlSortNormal

Selection.Copy

Range(”B12”).Select

Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _

False, Transpose:=True

End Sub

id:miku1973

早速ありがとう、やってみます!!

2004/06/13 20:17:49
id:kamicha1 No.7

kamicha1回答回数94ベストアンサー獲得回数02004/06/11 23:08:56

ポイント20pt

URLは、ダミーです。

以下のマクロでいかがですか?

自然数(1以上の正の整数)はチェックしていません。

Sub Test()

Dim RowNo As Integer

Dim c As Range

’出力範囲データ消去

Range(”A13:A112”).ClearContents

Rows(12).ClearContents

’開始行

RowNo = 13

’A1からJ10の値のうち空白以外の値を調査

For Each c In Range(”A1:J10”)

If c.Value > 0 Then

’A13から下に出力していく

Cells(RowNo, 1).Value = c.Value

RowNo = RowNo + 1

End If

Next

’A13から100行下までの範囲内で昇順(小さい数字順)にソート

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

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

:=xlPinYin, DataOption1:=xlSortNormal

Range(”A13:A112”).Copy

Range(”B12”).Select

’B12から右に行列変換

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=True

Range(”A12”).Select

Application.CutCopyMode = False

End Sub

id:miku1973

お?どうだろう?

やってみます。

2004/06/13 20:18:21
id:ozonepapa No.8

ozonepapa回答回数288ベストアンサー獲得回数02004/06/11 23:10:44

ポイント20pt

初めての回答で要領を得ないのですが、

こんな感じでしょうか?

VBAも始めて使ってみました、もっといい方法があるかも知れませんが、とりあえず、オーソドックスなBasicで書いてみました。

以下が、VBAになります。

Sub tate()

Dim i As Integer

Dim j As Integer

Dim k As Integer

k = 0

For i = 1 To 10

For j = 1 To 10

If Not IsEmpty(Cells(i, j)) Then

Cells(13 + k, 1) = Cells(i, j)

k = k + 1

End If

Next j

Next i

Range(Cells(13, 1), Cells(13 + k - 1, 1)).Sort (Cells(13, 1))

For i = 0 To k

Cells(12, 2 + i) = Cells(13 + i, 1)

Next i

End Sub

id:miku1973

す、すごい!一番シンプルですね。しかも

しっかりできました。

本当に初めて作ったのですか?すごすぎ!

これ使わせていただきます!!

2004/06/13 20:22:16

コメントはまだありません

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません