掃き出し法を使って解くようですが、
-1 0 0 2 0 0 0
0 0 -1 -2 0 0 0
0 -2 0 0 -1 1 0
0 2 1 0 0 0 0
0 0 0 -2 0 -1 0
0 0 0 2 0 0 1
このように、行の入れ替えが必要な場合、繰り返しを用いて行を入れ替える必要がありますよね？
下のように作ってみましたが、上手くいきません。↑の行列を正しく入れ替えるだけならできるのですが、もう一度プログラムを作動させるとエラーが出ます。
For j = l To 6
If Abs(a(j, l)) >= Abs(max) Then'0と負の値しかない場合、0が最大になってしまう
u = j 'このときの行を保存
End If
Next j
For m = 1 To 7
brank = a(l, m) '入れ替える前の値を保存
a(l, m) = a(u, m)
a(u, m) = brank
Cells(l, m) = Cells(u, m)
Cells(u, m) = brank
Next m
Next l
do loopを使った方が良いと聞いたのですが、どのようにすればよいのでしょうか？
現在VBA（Excel)にて統計のプログラムを作成しています。
Sheet２に統計表
統計対象のシートはシートタブの色が赤色(枚数不特定)
統計表の縦軸には、B４～15に４～３(１年度の月)。横軸にはF～J４に１～５。
統計対象シートの構成は同じで
セルE4に１～５の数字のどれか
セルE24には１～12の数字のどれかが入ります
統計表イメージ
A B C D
１ １ ２ ３
２ ４月
３ ５月
４ ６月
５ ７月
入力画面（シート名部分赤シート）
E4 ←１～５のどれか
E24 ←１～１２のどれか
この場合において、たとえばE4が"１"、E24が"４"だった場合
統計表のB2にカウントされるというプログラムが作りたいのですが、
Option Explicit
Private Sub CommandButton2_Click()
Dim Ws As Worksheet
Dim cnt As Variant
Dim grade() As Variant 'grade = grd = 学年
grade = Array("1", "2", "3", "4", "5")
Dim month() As Variant 'month = mnt = 月
month = Array("4", "5", "6", "7", "8", "9", "10", "11", "12", "1", "2", "3")
Dim grd As Integer '各変数宣言
Dim mnt As Integer
Dim set1 As Integer
Dim set2 As Integer
Dim 月ー所 As Worksheet
For grd = 1 To 5
If Cells(4, 5).Value = grade(grd - 1) Then
cnt = 0
set1 = grd + 5
End If
For mnt = 1 To 12
If Cells(24, 5).Value = month(mnt - 1) Then
set2 = mnt + 3
End If
For Each Ws In Worksheets
If Ws.Tab.ColorIndex = red Then
cnt = cnt + 1
End If
Next
Worksheets("月ー所").Cells(set2, set1).Value = cnt ←この行でエラー1004
Next mnt
Next grd
MsgBox "統計しました。"
End Sub
矢印で示した行のエラー1004の解除方法が分からず悩んでいます
どうかよろしくお願いいたします。
http://okwave.jp/qa/q6535908.html
で、完成かと思われましたが・・・。
円の雛型の各種設定が保存・呼び出しで初期化されるという不具合が発生。
急遽、円を生成することにしました。
そこで、次の質問を致します。
質問１、.Ovals.Add(200, 0, 20, 20) は、これでよいのでしょうか？
質問２、.Border.LineStyle で点線の記号定数
質問３、文字の垂直方向の指定要領・・・中心
質問４、内部の余白の指定要領・・・上下を０に
なお、現在の円を生成するコードは次のようです。
Sub cmdUpdateSokueki_1()
Set myDocument = Worksheets("調査データ")
Dim r As Range ' 読み込むRange
・・・・・
Dim shapeCounter As Integer ' 描画する円のカウンター(=name)
With myDocument
For Each r In .Range("C15", .Range("C65536").End(xlUp))
・・・・・
If tubeState >= 0 Then
・・・・・
createShapes_1 "特殊部管理台帳", shapeCounter, shapeNumber, tubeState, shapeDiameter
・・・・・
End If
Next r
End With
End Sub
更新Subが呼び出す Sub です。
Public Sub createShapes_1(ByVal sheetName As String, _
ByVal shapeCounter As Integer, _
ByVal shapeNumber As Integer, _
ByVal tubeState As Integer, _
ByVal shapeDiameter As Single)
Set myDocument = Worksheets(sheetName)
Dim intLeft As Integer
Dim intTop As Integer
With myDocument
intLeft = .Range("I37").Offset(, (shapeCounter Mod 7) * 2).Left
intTop = .Range("I37").Offset((shapeCounter \ 10) * 2, 0).Top
With .Ovals.Add(200, 0, 20, 20)
Select Case tubeState
Case 0
.Border.LineStyle = msoLineSolid ' 本来は点線 ＊＊＊＊＊＊＊＊
.Interior.Color = vbWhite
.Font.Color = vbWhite
Case 1
.Border.LineStyle = msoLineSolid
.Interior.Color = vbWhite
.Font.Color = vbBlack
Case 2
・・・・・
Case Else
End Select
.Name = "oval100" & Format(shapeCounter, "00")
.Placement = xlMove
・・・・・
.Left = intLeft
.Top = intTop
.Orientation = 3
End With
End With
End Sub
PS:一応は所定の位置に円を描画しています。
