• ベストアンサー
※ ChatGPTを利用し、要約された質問です(原文:エクセル2003のVBAで列を指定)

エクセル2003のVBAで列を指定

cj_moverの回答

  • ベストアンサー
  • cj_mover
  • ベストアンサー率76% (292/381)
回答No.6

こんにちは、 レスをありがとうございます。 ◆◆◆ >arrMatrix(i) = mtxTemplate >これって、一次元配列の要素に二次元配列をいれているのでしょうか? はい、その通りです。 サイズ(行数と列数)を定義済みの空の二次元配列(mtxTemplate)を 一次元配列(arrMatrix)の要素に代入しています。 ◆◆◆ あれこれ書き過ぎたみたいなので、少し整理しますが、 配列を使うかどうかは二の次三の次でして、 (1)処理対象のセル範囲(過不足なく)全体を先に取得しておく事 (2)処理対象のセル範囲を Areas で捉え、Area 毎に処理する事 の2点が私のレスのメインテーマです。 (ただひとつ testJ だけは↑(2)と無関係ですが) 処理の選択肢が増え、効率的になること、を示したかったということです。 その為の方法として参照文字列や参照演算子を見直してみてはどうか という提案も書きました。 ◆◆◆ >実際には...作業はもっと複雑です。 無理に汎用性を持たせようとして却って、 解り難い書き方をしてしまった No.5 の testM ですが "云われたことだけを決打ち"的に実現するなら二段階配列なしで、 もっとシンプルに書けますので一応補足として掲げておきます。 重要なのはあくまでも Areas プロパティの使い方、その可能性 であることに変わりはありません。 ◆◆◆ Sub test_() ' 7058428okg ' ' 列の変更はここで指定 ↓" Const S_REF = "(A:A,C:C,G:G,H:H,K:K,M:M,O:O,S:S,T:T,W:W,Y:Y,AA:AA,AE:AE,AF:AF,AI:AI,AK:AK,AM:AM,AQ:AQ,AR:AR,AU:AU,AW:AW,AY:AY,BC:BC,BD:BD,BG:BG,BI:BI,BK:BK,BO:BO,BP:BP,BS:BS,BU:BU,BW:BW,CA:CA,CB:CB,CE:CE,CG:CG,CI:CI,CM:CM,CN:CN,CQ:CQ) 2:20001"   Dim nMtx() As Long   Dim r As Range   Dim nTop As Long, nBottom As Long   Dim n As Long, i As Long   ' ' 先頭行位置を求める   nTop = Val(Mid(S_REF, InStrRev(S_REF, " ") + 1))   ' ' 末尾行位置を求める   nBottom = Val(Mid(S_REF, InStrRev(S_REF, ":") + 1))   ' ' 二次元配列のサイズ(先頭行から末尾行*1列)を定義   ReDim nMtx(nTop To nBottom, 0) As Long   ' ' 対象セル範囲ををAreasで捉えてArea毎に処理   For Each r In Range(S_REF).Areas     ' ' Area毎、二次元配列に数値をセット     For i = nTop To nBottom       n = n + 1 ' カウンタ       nMtx(i, 0) = n ' 数値を二次元配列にセット     Next i     ' ' それぞれのAreaに、二次元配列の数値をセット     r.Value = nMtx   Next r   Erase nMtx ' メモリ初期化 End Sub

emaxemax
質問者

お礼

> レスをありがとうございます。 ありがとうだなんて・・・。 お礼を言わなければいけないのは私のほうです。 cj_moverさん、ほんとに丁寧に有難うございます。 今回の回答を見て、やっと前回のが理解できたような気がします。 物覚えの悪いemaxemaxをご指導いただき感謝感激です。 これからもよろしくお願い申し上げます。

関連するQ&A

  • エクセルVBAの条件指定が上手くいきません

    「7を超えたら、For Eachステートメントを抜けなさい」という条件を入れたいのですが、 7を超えても処理が継続し困っています。 勉強不足で申し訳ないですが、ご教授願います。 【やりたいこと】 まず、セルB1~D3までのセルの値(9つ)が、7を超えない条件で1を加算していきます。 加算したときの値はE~Gの列に貼り付けていきます。 7を超えた時点でFor Eachステートメントを抜けます。 また、B1~D3までのセルには計算式が入っており、A1に数字を入れると、 それぞれ異なる増え方をします。(計算式自体は$A$1+1.1、$A$1+2.1などシンプルなもの) Sub test() Dim i As Range Dim n As Long Dim x As Long n = 1 x = 1 For Each i In Range("B1:D3") Range("A1").Value = x If i < 7 Then Range("B1:D3").Copy Cells(n, 5).Select Selection.PasteSpecial Paste:=xlPasteValues n = n + 3 x = x + 1 ElseIf i > 7 Then Exit For End If Next End Sub お手数ですが、宜しくお願いいたします。

  • 指定した文字列が含まれる行を削除する

    データの照合をしています。 指定した文字列が、「O列」に入っていたら、その行を削除し、 行をつめる というようなマクロを組みたいのですが、エラーがかかってしまいます。 (下のVBは、ネットで公開されていたのを使用させていただいております。) Sub Macro1() Const col As String = "A" '文字列が入力されている列 Dim idx As Long Dim keyWord keyWord = Application.InputBox("削除対象の文字列は?", Type:=2) If TypeName(keyWord) <> "Boolean" And Len(keyWord) > 0 Then   For idx = Cells(65536, col).End(xlUp).Row To 1 Step -1     If InStr(Cells(idx, col).Value, keyWord) > 0 Then '    If Application.CountIf(Rows(idx), "*" & keyWord & "*") > 0 Then       Rows(idx).Delete     End If   Next idx End If End Sub 「下から3行目のNEXTに対応するforがない」とエラーがでます。 ご教授、お願いいたします。

  • 複数の列を繋げてA列に入れたい VBA

    aaa aaa  bbb aaa  bbb  ccc aaa (A列にaaa、B列にbbb、C列にcccが入ってます) と言うデータがあるのですが 全てA列に入れて aaa aaabbb aaabbbccc aaa としたいです。 ・最終列は必ずしもCではないのです。(Dの場合もEの場合もある) ・最終行も変化します。 Sub 分かれてる列を繋げる() Dim Col As Long Dim Row As Long For Row = 1 To Range("a65536").End(xlUp).Row   For Col = 1 To Cells(Row, 256).End(xlToLeft).Column    Cells(Row, 1) = Cells(Row, 1) & Cells(Row, 2) & Cells(Row, 3)    Next Col Next Row End Sub をやってみましたが、 aaa aaabbbbbb aaabbbcccbbbcccbbbccc aaa となってしまい、 欲しい結果とは違くなってしまいます。

  • シートの全てを半角にする

    A列からT列、 行は10000行ほどあるのですが 全てを半角にしたいのですがマクロでないと無理でしょうか? Sub 全てを半角にする() Dim row行 As Long Dim col列 As Long For col列 = 1 To Range("IV1").End(xlToLeft).Column For row行 = 2 To Cells(65536, 2).End(xlUp).Row Cells(row行, col列) = StrConv(Cells(row行, col列), vbNarrow) Next row行 Next col列 End Sub でやるしかないですか? もっと効率のいい方法があったら教えてください!

  • エクセルVBA 行と列の取得

    ご教授下さい。 エクセルでの行と列の最初とデータの入っている最後のデータを以下のようにしてテキストで 取得しようと考えています。 Private Sub Workbook_BeforeClose(Cancel As Boolean) Dim StrFN As String StrFN = "パス.txt" Dim i As Long, LngLoop As Long Dim IntFlNo As Integer Worksheets("sheet1").Activate LngLoop = Range("a65536").End(xlUp).Row IntFlNo = FreeFile Open StrFN For Append As #IntFlNo For i = 1 To LngLoop Write #IntFlNo, Cells(i, 1), 'ログ出力範囲 Next i Close #IntFlN End Sub どうやら列の指定がうまくいってないようです。 Cells(i, 1), 'ログ出力範囲の1をどのように指定すればいいでしょうか? 取得したい範囲については添付しました。 どうかよろしくお願いいたします。

  • エクセルVBA/シェープの文字列を取得

    エクセル2010です。 BOOK内の各シートにボタンやチェックボックス、ラベルやテキストボックスなどが配置されています。 これらの貼り付けられたものの一覧を作りたいのです。 Sub obj_Check() Dim st Dim sp Dim i As Long For Each st In Sheets For Each sp In st.Shapes i = i + 1 With Sheets("Sheet3") .Cells(i, "A").Value = sp.Name ' .Cells(i, "B").Value = sp.Caption ’これがエラー .Cells(i, "C").Value = st.Name End With Next sp Next st End Sub とやってみましたがsp.Captionがエラーになります。 .Cells(i, "B").Value = sp.Shapes.Range.Character.Text としても同じです。 どうやったら、シェープに書かれた文字列が取得できるのでしょうか?

  • 列を変更して転記したいのですが。

    すみません、誰か教えていただけませんか。 A列に値が入力がされていて、その値をF列に転記していき 15行までいけば2列横にズレて転記していき更に、15行で 2列横と続けたいのですがうまく出来ません。 下記のように記述してみたのですが、値が置き換わるだけで 転記出来ません。 誰か教えて頂けませんでしょうか。 Sub TEST() Dim i As Long, ii As Long Dim myR As Long myR = Worksheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Row ii = 5 For i = 1 To myR Cells(1, ii).End(xlUp).Offset(0, 1).Value = Cells(i, 1).Value If Cells(1, ii).End(xlUp).Row = 15 Then ii = ii + 2 End If Next i End Sub 宜しくお願いします。

  • エクセルVBAで表の塗りわけ

    エクセル2003です。 添付画像のような表を、B列の時刻を基準に、何時台かで表を上から順に4色に色分けしようと思います。 一応、以下のコードで出来たのですが、Offset(-1).Value で見ている1行目のタイトル行が文字列なのでOn Error Resume Next でエラー回避しなくてはいけません。 他にもっと良い方法はないでしょうか? Sub test001() Dim cl As Variant Dim n As Long cl = Split("2,19,35,39", ",") For Each rng In Range("B2", Cells(Rows.Count, "B").End(xlUp)) On Error Resume Next If Hour(rng.Value) <> Hour(rng.Offset(-1).Value) Then n = n + 1 End If On Error GoTo 0 rng.EntireRow.Interior.ColorIndex = Val(cl(n Mod 4)) Next End Sub

  • エクセルVBA

    A列を基準にBC列が空白ならAの数値を入れて、A>BならB列を更新、A<CならC列を更新 A列が数値以外ならその行をスキップ、という処理をしたいのですが Option Explicit Dim A As Range, B As Range, C As Range Dim i As Long Sub test() For i = 1 To 10 Set A = Cells(i, 1) Set B = A.Offset(0, 1) Set C = A.Offset(0, 2) If IsNumeric(A) Then Else Exit Sub End If If B.Value = "" Then B.Value = A.Value If C.Value = "" Then C.Value = A.Value If A.Value > B.Value Then B.Value = A.Value If A.Value < C.Value Then C.Value = A.Value Next i End Sub とすると数値以外の行の時点で停止してしまいます。 その行を飛ばして次の行に進むにはどうしたらいいのでしょうか?

  • range表記をcells表記にしたい

    B列の最終行までループさせたいのですが Sub Sample() Dim col As Long col = 2 For Each R In Range("B1:B" & Cells(Rows.count, "B").End(xlUp).Row) Next End Sub この状態から、Bを使わずに、 col = 2を使って、書き換えてもらっても良いですか? For Each R In Range(Cells(1, col), Cells((Rows.count, col)).End(xlUp).Row) これにするとエラーになります。