『L・DK』上白石萌音&杉野遥亮インタビュー!

Excel 2016を使用しています。
現在、利用予定表を作成しております。
下記のような表(画像参照)があり地域毎に並び替えを一気にしたいのですが可能でしょうか。

カレンダー形式にしており
A列,D列,G列…(3行毎) に通し番号
B列,E列,H列…(3行毎) に名前
C列,F列,I列…(3行毎)  に地域

これが31日分カレンダー形式で作っています。

通し番号はそのままで
日付のグループ?ごとに
地域順に並び替えをしたいのですがマクロで可能でしょうか。
その地域がまとまってくれればいいのでフリガナ等は考慮しなくて大丈夫です。

B5:C9の範囲ひとつでならマクロで並び替えできたのですが
どうしても複数となるとわからなくなってしまいました。

乱文で申し訳ありませんがよろしくおねがいいたします。

「Excel VBA マクロ 複数範囲を並」の質問画像

A 回答 (5件)

こんにちは!



横からお邪魔します。
お示しの画像の配置で列方向には7日分、行方向には1か月の最終日まであるとしての一例です。
尚、①~⑤に関しては並び替えはしなくてよいのですよね。
一例です。

Sub Sample1()
 Dim i As Long, j As Long
 Dim myRng As Range
  For i = 5 To Cells(Rows.Count, "B").End(xlUp).Row Step 7 '//←B列5行目~B列最終行まで7行おき★//
   For j = 2 To Cells(i, Columns.Count).End(xlToLeft).Column Step 3 '//←B列~最終列まで3列おき★//
    If Cells(i, j) <> "" Then
     Set myRng = Cells(i, j).Resize(5, 2)
      myRng.Sort key1:=myRng(2), order1:=xlAscending, Header:=xlNo
    End If
   Next j
  Next i
   MsgBox "完了"
End Sub

※ 都道府県?の昇順で並び替えを行っていますので、
お示しの画像だと「福岡」が最後の方にかまとまってしまいます。

コード内の
>xlAscending

>xlDescending
にすれば降順になりますので、福岡が上の方にまとまりますね。

昇順・降順は好みで変更してみてください。m(_ _)m
    • good
    • 0
この回答へのお礼

ありがとうございました!
こちらでなんとかいけそうです!!助かりました!

お礼日時:2019/04/27 16:44

任意の地域順で並べられるように書いてみました。




Sub test()


Range("B5").Select

Dim i As Integer '下方向への繰り返し
Dim x As Integer '右方向への繰り返し

For i = 1 To 5 '5週分繰り返す
   For x = 1 To 7 '7日分繰り返す
    If ActiveCell.Value <> "" Then 'データが入っていなければ次に
     With ActiveSheet.Sort
       .SortFields.Clear
       .SortFields.Add Key:=ActiveCell.Offset(0, 1), CustomOrder:="東京, 大阪, 福岡, 京都, 愛知"
       .SetRange ActiveCell.Resize(5, 2)
       .Header = xlNo
       .Orientation = xlTopToBottom
       .Apply
     End With
    End If
    ActiveCell.Offset(0, 3).Select
   Next x
   ActiveCell.Offset(7, 0 - (3 * (x - 1))).Select
 Next i
 Range("B5").Select
 MsgBox ("地域の並べ替えが終わりました")

End Sub
    • good
    • 0
この回答へのお礼

ありがとうございます!今後並べ替えの順序も必要になってきそうなのでそのとき使わせていただきます!

お礼日時:2019/04/27 16:44

なんどもごめんなさい。



、「 Range("A5:C9") のA5を ”A1セル” に見立てるので、C9セルは " C1 ” たことになる」というような意味になります。

も間違いで、正しくは、


、「 Range("A5:C9") のA5を ”A1セル” に見立てるので、C5セルを " C1 ” に見立てたことになる・・・(C9はC5に見立てたことになる」というような意味になります。

でした。

教えてGooって投稿を書き直せないのかしら・・・。すみません。
    • good
    • 0
この回答へのお礼

何度もありがとうございます!!わかりやすく説明していただき感謝しかありません。
もう少しいろいろがんばってみます。

お礼日時:2019/04/27 16:45

すみません。


変数設定の

Dim i_tate As Integer

のあとに

Dim i As Integer
Dim j As Integer

が抜けてましたので追記してください。

あと冒頭、「某」ではなく、」「私」でした。
    • good
    • 0

某も初心者なので、古いやり方でしかもダサいコードですみませんが、例えば以下のような感じではどうでしょうか?



全バージョンで使える「Range.Sortメソッド」を使っています。
「ユーザー設定リスト」で設定した並べ替えを適用したかったら、
「Order1:=xlAscending」
の後ろに、
「, OrderCustom:=13」
をくっつけるみたいです。
(13はいくつめの設定かによって数字が変わるようです。)
詳しくは
http://officetanaka.net/excel/vba/tips/tips148.htm
などもご参考に。

なお、「o_Rng01.Range("C1")」は「Range.Rangeプロパティ」ですが、
「Range("A5:C9").Range("C1")」といったような意味合いですが、
この場合ですと、「 Range("A5:C9") のA5を ”A1セル” に見立てるので、C9セルは " C1 ” たことになる」というような意味になります。
なので、相対的な感じのセルの指定になります。(説明下手ですみません。)
よって、並べ替えしたいセル範囲がズレていっても、常に、「3列目の1行目を並べ替えのセルの基準にしている」という意味になります。

2007以降は、「Range.Sortメソッド」での並べ替えのほかに、上記サイトにもあるとおり、「Sortオブジェクト」(Worksheet.Sort?)が使えます。

なお、下記コードをもしお試しになるなら、必ずファイルのバックアップをとってからにしてください。(データをめちゃくちゃにしてしまうといけませんので・・・)


Sub test()

Dim o_Rng01 As Range
Dim i_yoko As Integer
Dim i_tate As Integer

i_yoko = 0
i_tate = 0

For i = 1 To 5 '縦のループ(週単位)

For j = 1 To 7 '横のループ(日単位)

Set o_Rng01 = Range(Cells(5 + i_tate, 1 + i_yoko), Cells(9 + i_tate, 3 + i_yoko))

'並べ替えしたいキーの列が空白だったら、プログラムを終わる。
If o_Rng01.Range("C1") = "" Then Exit Sub

o_Rng01.Sort Key1:=o_Rng01.Range("C1"), Order1:=xlAscending

Set o_Rng01 = Nothing
i_yoko = i_yoko + 3

Next j

i_yoko = 0
i_tate = i_tate + 7

Next i



End Sub
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

このQ&Aと関連する良く見られている質問

Qセルに参照するアドレスを表示させ、別のセルに値を出すやり方

すみません。どうしてもわからないので教えてください。
EXCELは2013を使用しています。

sheet1: データがある表
sheet2: sheet1を基にデータを表示

sheet2のA列とB列には参照したいセルの列と行が記載してあり
C列にはA列とB列を組み合わせた参照したいアドレスが関数で記載してあります。
そこでC列で参照したいアドレスを基にD列に結果を表示させるにはどうしたら良いでしょうか。
アドバイスよろしくお願い致します。

<sheet1>
 A列
1.マドレーヌ
2.フィナンシェ

<sheet2>
 A列(列) B列(G等) C列(関数)       C列に表示される形) D列
1.A    2     ="=sheet1!"&A1&(B1) ⇒ =sheet1!A2     フィナンシェ

Aベストアンサー

C列の関数を変更しないのなら、こちら↓で対応します。
 =INDIRECT(MID(C1,2,LEN(C1)-1))

C列の先頭にある等号記号を記載しないで、表示形式で対応すれば
もっと簡単になります。
C列の表示形式を
 "="@
にしたら、C列の関数を
 ="sheet1!"&A1&(B1)
とする。これならD列は
 =INDIRECT(C1)
だけで参照できます。

Qエクセル リストと完全一致するセルに色をつける

シート1のA列とB列に
aaa ccc
bbb ggg
ccc kkk
ddd ooo
と言うリストがあって、A1〜A4はAチーム、B1〜B4まではBチームと名前を付けています
シート2にAチームのリスト4個が続いているものがあればセルを赤、Bチームのリスト4個が続いているものがあればセルを黄色に塗りたいです
AチームとBチームの中には同じ品番がある時もあります
条件付き書式で設定は出来るでしょうか?

Aベストアンサー

(´・ω・`)
”○” の数を数えるんじゃないんだよなあ。

・・・本題・・・

条件付き書式ですよね。

シート2のリストの並び順は
 aaa
 ccc
 bbb
 ddd
では「Aチーム」と認識しないという事でよろしいでしょうか?
ならば、とても簡単です。

シート2の一覧において、

 判定するセル1
 判定するセル2
 判定するセル3
 色を付けるセル
 判定するセル4
 判定するセル5
 判定するセル6

という範囲について調べれば良いという事。

 判定するセル1
 判定するセル2
 判定するセル3
 色を付けるセル

 判定するセル2
 判定するセル3
 色を付けるセル
 判定するセル4

 判定するセル3
 色を付けるセル
 判定するセル4
 判定するセル5

 色を付けるセル
 判定するセル4
 判定するセル5
 判定するセル6

の4パターンについてそれぞれ調べれば良いだけ。

自分なら
 aaa-bbb-ccc-ddd
のようにシート1から文字列を作り、それが調べるセルで同じパターンになるかを調べます。
シート1はA5セルから、シート2はA11セルからデータが入力されているなら、

 シート1!A5 & シート1!A6 & シート1!A7 & シート1!A8 = A11 & A12 & A13 & A14
 シート1!A5 & シート1!A6 & シート1!A7 & シート1!A8 = A12 & A13 & A14 & A15
 シート1!A5 & シート1!A6 & シート1!A7 & シート1!A8 = A13 & A14 & A15 & A16
 シート1!A5 & シート1!A6 & シート1!A7 & シート1!A8 = A14 & A15 & A16 & A17

という条件になる。
この4つのうちの一つでも条件を満たせばセルに赤色を付ければいい。
「Bチーム」についても同様にすればいいので、
この場合、8つの条件式を設定することになります。

面倒でもこの考え方ができていないと、ちょっと条件が変わっただけで対処できずに終わります。
冒頭で「並び順」について書きましたが、並び順がシート1のリストの通りでなくとも色を付けたい場合でも、この考え方は必要ということです。

・・・
ちなみに厄介なのが、どちらのチームにも「ccc」がいるというところかな。
これが無ければ違う方法でシンプルにできるんですけどねえ。

(´・ω・`)
”○” の数を数えるんじゃないんだよなあ。

・・・本題・・・

条件付き書式ですよね。

シート2のリストの並び順は
 aaa
 ccc
 bbb
 ddd
では「Aチーム」と認識しないという事でよろしいでしょうか?
ならば、とても簡単です。

シート2の一覧において、

 判定するセル1
 判定するセル2
 判定するセル3
 色を付けるセル
 判定するセル4
 判定するセル5
 判定するセル6

という範囲について調べれば良いという事。

 判定するセル1
 判定するセル2
 判定するセル3
 色を付け...続きを読む

QExcelで「令和」と表示されるのは5月1日にならないとだめですか?

「日本の新元号に関する Office の更新プログラム」というページ(下記)で、
「Windows と Office の更新プログラムを適用済みの場合でも、Windows 上で実行されている Office 製品は 2019 年 5 月 1 日に新元号が開始されるまで、新元号を表示しませんのでご注意ください。」
と書かれています。
https://support.microsoft.com/ja-jp/help/4478844/office-updates-for-new-japanese-era

今月4月中に、Excelのセルに来月5月以降の年月日を入力した場合に、自動で「令和」という元号を表示させることはできないのでしょうか。

もし、できるということであれば、「2019 年 5 月 1 日に新元号が開始されるまで、新元号を表示しません」とはどのような意味なのでしょうか。

Aベストアンサー

>こちらでは、「4月17日以降にOfficeも更新されれば「令和元年」と表示されると思います」と書かれているんですが

その方は、Microsoftの方ではないですし個人の予想ですよね?公式が出ているのにそれを持ち出してどうするんですか?

5/1より前に新しい元号を表示したい場合は数式や表示形式で限定的に表示させる方法を色々な方が考え付いていますよ。
検索すればたくさん出てきます。

Qオートフィルを使ったマクロを作りましたが、時間がかかります。

初心者です。
検索で拾ったコードを組み合わせて、下のようなコードでマクロを作りました。
2万行を超えるデータを、オートフィルである列の中から「1」以外を行で削除するようにします。
実際に実行すると、時間がかかりポインタがクルクルとなっています。
もっと早く処理できるようにできますでしょうか。どこかおかしいところがありますでしょうか。
ご指摘のほどよろしくお願いします。

Sub コマンドボタン枝番_Click()

Dim intRowCount, i As Integer
Dim lngTotal, lngWriteTotal As Long

If MsgBox("枝番1以外を削除します。" & vbCrLf & _
"処理を実行しますか?", vbYesNo + vbQuestion, "行削除マクロ") = vbNo Then
Exit Sub

End If

Application.ScreenUpdating = False

lngTotal = Application.WorksheetFunction.CountA(Range("AV2:AV40000"))

Worksheets("全体").Activate
Worksheets("全体").Range("AV1").Select
Selection.AutoFilter

Selection.CurrentRegion.Select
intRowCount = Selection.Rows.Count + 1

ActiveSheet.Range("$A$1:$BO$40000").AutoFilter Field:=48, Criteria1:=">1", _
Operator:=xlAnd
Rows("2:40000").Select
Selection.Delete Shift:=xlUp
Selection.AutoFilter
Application.Goto reference:=Range("A1"), Scroll:=True

lngWriteTotal = WorksheetFunction.CountA(Range("AV2:AV40000"))

MsgBox "処理を完了しました。" & vbCrLf & _
"件数:" & vbCrLf & lngWriteTotal

Worksheets("手順シート").Activate

Application.ScreenUpdating = True

Exit Sub

End Sub

初心者です。
検索で拾ったコードを組み合わせて、下のようなコードでマクロを作りました。
2万行を超えるデータを、オートフィルである列の中から「1」以外を行で削除するようにします。
実際に実行すると、時間がかかりポインタがクルクルとなっています。
もっと早く処理できるようにできますでしょうか。どこかおかしいところがありますでしょうか。
ご指摘のほどよろしくお願いします。

Sub コマンドボタン枝番_Click()

Dim intRowCount, i As Integer
Dim lngTotal, lngWriteTotal As Long

I...続きを読む

Aベストアンサー

オートフィルタの状態で削除するから、実際は飛び飛びの行削除になっててそこで処理が重くなってるんじゃないかと。

先に、AV列(48番目の列)でソートをかけてしまって、
そののちに1以外(1より大きい数でいいんですよね?)をフィルターすると、
連続した列の削除になるので、処理時間が短くなります。

投稿されたコードの途中に★★★で囲まれた部分を追加して、処理速度を確認してみてください。

・・・
lngTotal = Application.WorksheetFunction.CountA(Range("AV2:AV40000"))
Worksheets("全体").Activate
'★★★
ActiveWorkbook.Worksheets("全体").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("全体").Sort.SortFields.Add Key:=Range("AV2:AV40000") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("全体").Sort
.SetRange Range("A1:BO40000")
.Header = xlYes
.Apply
End With
'★★★★
Worksheets("全体").Range("AV1").Select
Selection.AutoFilter
・・・

オートフィルタの状態で削除するから、実際は飛び飛びの行削除になっててそこで処理が重くなってるんじゃないかと。

先に、AV列(48番目の列)でソートをかけてしまって、
そののちに1以外(1より大きい数でいいんですよね?)をフィルターすると、
連続した列の削除になるので、処理時間が短くなります。

投稿されたコードの途中に★★★で囲まれた部分を追加して、処理速度を確認してみてください。

・・・
lngTotal = Application.WorksheetFunction.CountA(Range("AV2:AV40000"))
Worksheets("全体").Activat...続きを読む

QVBAのエラーについて、”実行時エラー424オブジェクトが必要です”

gooで初めて質問します、VBAのエラーについて。

エクセルのシートにActiveXのチェックボックスを挿入しマクロを
作ろうと試みています。VBAの知識がないので、サンプルを
ダウンロードして作ろうと思っています。ところが、ダウンロードした
サンプルを動作させると、”実行時エラー424オブジェクトが必要です”
というメッセージがでます。どこを修正すればよろしいでしょうか?
エクセル2007を使用しています。よろしくお願いします。
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub checkbox()
Dim コントロール As Control
Dim チェック状態 As Boolean
チェック状態 = False
For Each コントロール In Controls '質問者記入:エラーメッセージがでる。
If TypeName(コントロール) = "CheckBox" Then
If コントロール.Value = True Then
チェック状態 = True
Exit For
End If
End If
Next
If チェック状態 = False Then
MsgBox "選択されていません。"
Exit Sub
End If
End Sub

gooで初めて質問します、VBAのエラーについて。

エクセルのシートにActiveXのチェックボックスを挿入しマクロを
作ろうと試みています。VBAの知識がないので、サンプルを
ダウンロードして作ろうと思っています。ところが、ダウンロードした
サンプルを動作させると、”実行時エラー424オブジェクトが必要です”
というメッセージがでます。どこを修正すればよろしいでしょうか?
エクセル2007を使用しています。よろしくお願いします。
ーーーーーーーーーーーーーーーーーーーーーーーーーーーー...続きを読む

Aベストアンサー

私も大して分かってないのですみませんが、ご提示されたWebのサンプルコードは、「ユーザーフォーム」の上に作ったチェックボックス用かなにかのコードのようです。
シート上に作った「「ActiveXコントロールのチェックボックス」の場合は、同じチェックボックスでも少し勝手が異なるみたいです。

a:変数「コントロール」の宣言が、「Dim コントロール As OLEObject」になる。
(=「Control」型ではなく、「OLEObject型」になるみたいです。)
b:「Cntrols」が「Worksheets("sheet1").OLEObjects」になる。
c:「コントロール」や「コントロール.Value」に「Object.」がくっつく。
・・・という感じで・・・。

少し作り変えてしまいましたが、以下のコードを試すとどうなりますでしょうか?
「Sheet1」の上に作ったチェックボックスを調べていくコードです。
(たぶん、動くと思うんですけど・・・。動かなかったらごめんなさい!)

※もし「Shhet1」が作ってなければ、「Sheet1」を作って、その上に、ActiveXコントロールの「チェックボックスを2、3個、作って、実行してみてください。


'#################################################################
'チェックボックスが「ActiveXコントロール」の場合
'#################################################################

Sub checkbox02()

Dim コントロール As OLEObject
Dim チェック状態 As Boolean
Dim s_CtlName As String

チェック状態 = False


For Each コントロール In Worksheets("sheet1").OLEObjects

If TypeName(コントロール.Object) = "CheckBox" Then
If コントロール.Object.Value = True Then
チェック状態 = True
s_CtlName = コントロール.Name
Exit For
End If
End If

Next


If チェック状態 = True Then
MsgBox s_CtlName & "にチェックが入っているっぽいです。"
ElseIf チェック状態 = False Then
MsgBox "選択されていません。"
Exit Sub
End If

End Sub




ちなみにですが、チェックボックスが「フォームコントロール」のほうで作られていると、以下のような感じのようです。

d:変数「コントロール」の宣言が、「Dim コントロール As checkbox」になる。
(=「Control」型ではなく、「checkbox型」になるみたいです。)
e:「Cntrols」が「Worksheets("sheet1").CheckBoxes」になる。
f:「コントロール.Value = True」が「コントロール.Value = 1」など、数値での判別になる。
・・・という感じで・・・。

※「Sheet1」上に、「フォームコントロール」の「チェックボックスを2、3個、作って、実行してみてください。


'#################################################################
'チェックボックスが「フォームコントロール」の場合
'#################################################################

Sub checkbox03()

Dim コントロール As checkbox
Dim チェック状態 As Boolean
Dim s_CtlName As String

チェック状態 = False


For Each コントロール In Worksheets("sheet1").CheckBoxes

If TypeName(コントロール) = "CheckBox" Then
If コントロール.Value = 1 Then 'チェックONだと「1」、OFFだと「-4146」です。
チェック状態 = True
s_CtlName = コントロール.Name
Exit For
End If
End If

Next


If チェック状態 = True Then
MsgBox s_CtlName & "にチェックが入っているっぽいです。"
ElseIf チェック状態 = False Then
MsgBox "選択されていません。"
Exit Sub
End If

End Sub

私も大して分かってないのですみませんが、ご提示されたWebのサンプルコードは、「ユーザーフォーム」の上に作ったチェックボックス用かなにかのコードのようです。
シート上に作った「「ActiveXコントロールのチェックボックス」の場合は、同じチェックボックスでも少し勝手が異なるみたいです。

a:変数「コントロール」の宣言が、「Dim コントロール As OLEObject」になる。
(=「Control」型ではなく、「OLEObject型」になるみたいです。)
b:「Cntrols」が「Worksheets("sheet1").OLEObjects」になる。
c:「...続きを読む

Qマクロ 最終行の値を求めてリプレイス関数で置き換える方法

資料を毎日作成しており、シート請求の中のBE列に登録日がデータとしてあります。
現行はBE2りで値には2019/04/08と入っているデータをリプレイス関数を使って
2019_04_08と置き換えてファイルの名前でデータを保存する作業をしております。

Sheets("請求").Select
trkb = Replace(expression:=Range("BE2").Value, Find:="/", Replace:="_", Start:=1)
hzk = Right(trkb, 5)
BE列の最終行の登録日の値を求めてリプレイス関数を用いて上記の通り置き換えが出来る
方法をご存知の方おられましたら回答戴きたいのでお願い致します。

Aベストアンサー

何故にReplace関数?普通はこうすると思うのですが・・・。

Sub sample()
Dim hzk As Variant
hzk = Worksheets("請求").Cells(Rows.Count, "BE").End(xlUp).Value
hzk = Format(hzk, "mm_dd")
MsgBox hzk
End Sub

QVBAでセル入力の数式に変数を用いたい

VBAで、下記"=SUM(F2:JY2)"の列のところを変数にしたいのですが、どのようにすれば
良いでしょうか?

Range(Cells(2, lastCol + 1), Cells(lastRow, lastCol + 1)) = "=SUM(F2:JY2)"

行の場合は例えば
"=SUM(F2:JY" & lastRow & ")"
のようにしていますが、列で悩んでいます。


"=SUM(F2:JY2)"
↑JYを変数にしたい。

Aベストアンサー

こんにちは

>"=SUM(F2:JY" & lastRow & ")"
>のようにしていますが、列で悩んでいます。
行番号の場合はそのままの数値が利用できるけれど、列の場合はAB等に変換しなくてはならないので困っているということでしょうか?

そういう面倒なことは、エクセルにやってもらうのが賢明かと思います。
例として、列番号である285がわかっていて、これから「JY]を導いて「F2:JY2」のセル範囲の文字列を作成したいという場合を想定します。

colNum = 285
addr = Range("F2").Resize(1, colNum - 5).Address(0, 0)
fmula = "=SUM(" & addr & ")"

MsgBox fmula  ' → "=SUM(F2:JY2)"

のような感じで、セル範囲の文字列化が可能です。
Addressプロパティのオプション指定で、絶対参照、相対参照やA1形式、R1C1形式を選択できますので、目的に合わせた形式で得ることができます。


一方、地道に、自前で変換することももちろん可能です。
列番号はAから始まる26進表記になっていますので、285/26、(285 mod 26)を計算して文字A(=Chr(65))からの順序をとれば可能そうです。
例えば、(以下は、少しインチキですが…)

colNum = 285
col = Chr(64 + Int(colNum / 26) ) & Chr(64 + (colNum Mod 26))
fmula = "=SUM(F2:" & col & "2)"
MsgBox fmula  ' → "=SUM(F2:JY2)"

となりますが、わざわざこんな面倒なことをやる必要もないですよね。
(上記は雰囲気を示すだけなので、実際には、桁数を判断して文字列を作成しないと、おかしなことが起こり得ます)

上記のような計算をするまでもなく、エクセルにやってもらえば
 MsgBox Cells(2, colNum).Address(0, 0)
で「JY2]を簡単に求めることができます。

こんにちは

>"=SUM(F2:JY" & lastRow & ")"
>のようにしていますが、列で悩んでいます。
行番号の場合はそのままの数値が利用できるけれど、列の場合はAB等に変換しなくてはならないので困っているということでしょうか?

そういう面倒なことは、エクセルにやってもらうのが賢明かと思います。
例として、列番号である285がわかっていて、これから「JY]を導いて「F2:JY2」のセル範囲の文字列を作成したいという場合を想定します。

colNum = 285
addr = Range("F2").Resize(1, colNum - 5).Address(0, 0)
fmul...続きを読む

QExvel vba Range型変数格納時のエラー

Sub うまくいく()
Dim rng As Range, shp As Object

For Each shp In ActiveSheet.Shapes
With shp
Set rng = Range(.TopLeftCell, .BottomRightCell)
Debug.Print rng.Address
End With
Next shp

End Sub
----------------------------------------------------------------
Sub うまくいかない()
Dim rng As Range, shp As Object

Set shp = Selection.ShapeRange

With shp
Set rng = Range(.TopLeftCell, .BottomRightCell)
Debug.Print rng.Address
End With

End Sub
----------------------------------------------------------------
事前にオブジェクトを選択してからの
Set shp = Selection.ShapeRange

Set shp = ActiveSheet.Shapes.Range(Array("picture 2"))
などと直接指定してもいずれも
Set rng = Range(.TopLeftCell, .BottomRightCell)
のところで
実行時エラー '438':
オブジェクトは、このプロパティまたはメソッドをサポートしていません。
となってしまいます。

うまくいくのといかないのとの違いが判りません。どなたかお願いいたします。

Sub うまくいく()
Dim rng As Range, shp As Object

For Each shp In ActiveSheet.Shapes
With shp
Set rng = Range(.TopLeftCell, .BottomRightCell)
Debug.Print rng.Address
End With
Next shp

End Sub
----------------------------------------------------------------
Sub うまくいかない()
Dim rng As Range, shp As Object

Set shp = Selection.ShapeRange

With shp
Set rng = Range(.TopLeftCell, .BottomRightCell)
Debug.Print rng.Address
...続きを読む

Aベストアンサー

何度もすみません。

「うまくいくほう」をF8キーでステップ実行して
「For Each shp In ActiveSheet.Shapes」の実行直後に
ローカルウィンドウで「shp」の中身(変数内に格納されたもの)を見ると、
「Object/Shape」と表示されます。


「うまくいくほう」も同じくF8キーでステップ実行して
「Set shp = Selection.ShapeRange」の実行直後に
ローカルウィンドウで「shp」の中身(変数内に格納されたもの)を見ると、
「Object/ShapeRange」と表示されます。

両者を比較すると、同じ名前・型の変数なのに・・・、

★うまくいくほうは:「Object/Shape」、
つまり、「Shapeオブジェクト」のデータが格納され、

★うまくいかないほうは:「Object/ShapeRange」、
つまり、「ShapeRangeオブジェクト」のデータが格納され

・・・ています。

そして、ヘルプにて
「Shapeオブジェクト」のオブジェクトメンバーを調べてみると、「TopLeftCell」プロパティがちゃんと存在します。「オブジェクトの左上端にあるセルを表す Range オブジェクトを返します。値の取得のみ可能です。」とあり、「うまくいくほう」の動きとも合致します。

が、「ShapeRangeオブジェクト」のほうには、ヘルプのオブジェクトメンバーを調べてみても「TopLeftCell」プロパティは存在しません。

オブジェクトブラウザで「TopLeftCell」で完全一致で検索しても、ヒットするのは・・・
 ・ChartObject
 ・OLEObject
 ・Shape
・・・の三つだけです。
なので、「ShapeRangeオブジェクト」は確実に、「TopLeftCell」プロパティを保持・内包していません。

うまくいかないほうのコードではWithが無ければ、
Set rng = Range(shp.TopLeftCell, shp.BottomRightCell)
という意味になると思いますが、

すこしまとめますと・・・

うまくいくほうでは「変数shp」の中身は「Shapeオブジェクト」。
うまくいかないほうでは「変数shp」の中身は「ShapeRangeオブジェクト」。
そしてヘルプやオブジェクトブラウザによると、
「Shapeオブジェクト」は、「TopLeftCell」プロパティを保持・内包していますが
「ShapeRangeオブジェクト」は「TopLeftCell」プロパティを保持・内包していません。(ついでに、BottomRightCellも保持・内包していません。)

つまり、「ShapeRangeオブジェクト」は「TopLeftCell」プロパティも「BottomRightCell」プロパティも保持・内包していないのにもかかわらず、「変数shp」に代入(Set)してしまったので、そのため、
「shp.TopLeftCell」と書くことで「ShapeRangeオブジェクト.TopLeftCell」と書いたことになってしまい、
また、「shp.BottomRightCell」と書くことで「ShapeRangeオブジェクト.BottomRightCell」と書いたことになってしまったので、
変数「rng 」に代入する直前の段階で、
「いま、変数shpにはShapeRangeオブジェクトが代入されちゃってますが、ShapeRangeオブジェクトには、もともとTopLeftCellもBottomRightCellも内包されていませんよ?」=すなわち、「オブジェクトはこのプロパティ、またはメソッドをサポート(保持・内包)していません」とエラーが出てしまったのではないかと思います。

何度もすみません。

「うまくいくほう」をF8キーでステップ実行して
「For Each shp In ActiveSheet.Shapes」の実行直後に
ローカルウィンドウで「shp」の中身(変数内に格納されたもの)を見ると、
「Object/Shape」と表示されます。


「うまくいくほう」も同じくF8キーでステップ実行して
「Set shp = Selection.ShapeRange」の実行直後に
ローカルウィンドウで「shp」の中身(変数内に格納されたもの)を見ると、
「Object/ShapeRange」と表示されます。

両者を比較すると、同じ名前・型の変数なのに・・・...続きを読む

Q長いコードですが、途中で止まらないようにできないでしょうか。

同じ作業をコマンドボタンで1クリックで行うために、マクロを作りました。
ところが、繰り返し作業の回数が多く、コードも長くなったため、途中で止まってしまいます。
具体的には、20000行ぐらいになるデータのシートから、コード別のシートにコピーし、コピーが終わった元のデータに色付けするという作業です。
違うコードが同じにシートにコピーされるものもあります。
以下がそのコードになります。
Sub コマンドボタンCMdata_Click()
Application.ScreenUpdating = False
Dim My_Target As Range
Set My_Target = Sheets("003").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) '---これはメーカーコード003です。
With Worksheets("全体")
If .AutoFilterMode Then
 .AutoFilterMode = False
End If
 .Range("A1").AutoFilter Field:=4, Criteria1:=Array("1", "2", "3", "4", "103", "104", "963", "964"), Operator:=xlFilterValues
 .Sort.SortFields.Add _
   Key:=Range("D2"), _
   SortOn:=xlSortOnValues, _
   Order:=xlAscending
 .Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy My_Target
My_Target.Resize(1, 66).Delete Shift:=xlUp
 .Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Interior.Color = RGB(255, 255, 0)
 .AutoFilterMode = False
End With
”Set My_Target = ~ End With” の「Sheets("***")」と「Array("*")」の*を変えて、150回ほどコードごとに繰り返すことになります。
行数でいうと、2000行を超えてしまいます。
コードを分割しても、一度ブックを保存終了、再起動させて次の作業を行わなければ止まります。
スムーズに、止まらずに、1クリックで終わらせることはできないでしょうか。

同じ作業をコマンドボタンで1クリックで行うために、マクロを作りました。
ところが、繰り返し作業の回数が多く、コードも長くなったため、途中で止まってしまいます。
具体的には、20000行ぐらいになるデータのシートから、コード別のシートにコピーし、コピーが終わった元のデータに色付けするという作業です。
違うコードが同じにシートにコピーされるものもあります。
以下がそのコードになります。
Sub コマンドボタンCMdata_Click()
Application.ScreenUpdating = False
Dim My_Target As Range
Set...続きを読む

Aベストアンサー

Const行で、NAME_SRC_SHEETを"全体"という文字列として定義しているので
このエラーが出るということは"全体"という名前のワークシートが存在しないか、Const行の書き方(書く場所?)がおかしいということになります。


状況が良くわかりませんので

Const NAME_SRC_SHEET As String = "全体"

↑の行は削除して


With Worksheets(NAME_SRC_SHEET) を

With Worksheets("全体") にしてください。(質問文のプログラムと同じにします)



念の為確認しますが、
コピー元となる「20000行ぐらいになるデータのワークシート」として"全体"という名前のシート
およびコピー先として"003"という名前のワークシートは存在するのですよね?
("004"は私が適当に付けたものですので修正してください)


もし、更にエラーがでるようでしたら、実行したプログラムコード全てを張り付けて下さい。
(補足ではなくお礼欄に)

QVBAエクセル 指定ホルダーに保存されない

ネットで調べて、以下のVBAを書きました。
特定のホルダーを選択して、そこにセーブするものです。
これにより、成功するものと、うまくいかないものがあります。
つまり、ホルダーの下に保存ができない場合が多いです。
なぜでしょうか?
よろしくお願いいたします。

Sub save()
'ブックの保存
Application.DisplayAlerts = False

With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "*** フォルダを選択し、[OK]をクリック ***"
If .Show = True Then
folder = .SelectedItems(1)
Else
Exit Sub
End If
End With

ActiveWorkbook.SaveAs Filename:=Format(Date, "yyyy") _
, FileFormat:=xlOpenXMLWorkbook

ActiveWindow.Close

Application.DisplayAlerts = True

End Sub

ネットで調べて、以下のVBAを書きました。
特定のホルダーを選択して、そこにセーブするものです。
これにより、成功するものと、うまくいかないものがあります。
つまり、ホルダーの下に保存ができない場合が多いです。
なぜでしょうか?
よろしくお願いいたします。

Sub save()
'ブックの保存
Application.DisplayAlerts = False

With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "*** フォルダを選択し、[OK]をクリック ***"
If .Show = True...続きを読む

Aベストアンサー

Sub SavingFiles()  'プロパティやメソッド名はプロシージャ名には使いません。
 'ブックの保存
 Dim mFolder As String
 Application.DisplayAlerts = False 'これが必要かわかりません。
 
 If ActiveWorkbook.Name = ThisWorkbook.Name Then
  MsgBox "マクロを搭載した本ブックは、保存対象にはなりません。", vbCritical
 End If
'自ブックを保存対象に入れるなら、FileFormt の部分を、xlOpenXMLWorkbookMacroEnabled にする。

 With Application.FileDialog(msoFileDialogFolderPicker)
  .Title = "*** フォルダを選択し、[OK]をクリック ***"
  If .Show = True Then
   mFolder = .SelectedItems(1) & "\" '保存に失敗する理由は、\ が抜けているからか?
  Else
   Exit Sub
  End If
 End With

 ActiveWorkbook.SaveAs Filename:=mFolder & Format(Date, "yyyy") _
  , FileFormat:=xlOpenXMLWorkbook 'mFolderの項目を入れます。

 ActiveWorkbook.Close False 'ActiveWindowでは意味が違います。Falseは、保存後の数値の変化を許さないから。
 Application.DisplayAlerts = True
End Sub

Sub SavingFiles()  'プロパティやメソッド名はプロシージャ名には使いません。
 'ブックの保存
 Dim mFolder As String
 Application.DisplayAlerts = False 'これが必要かわかりません。
 
 If ActiveWorkbook.Name = ThisWorkbook.Name Then
  MsgBox "マクロを搭載した本ブックは、保存対象にはなりません。", vbCritical
 End If
'自ブックを保存対象に入れるなら、FileFormt の部分を、xlOpenXMLWorkbookMacroEnabled にする。

 With Application.FileDialog(msoFileDialogFolderPicker)
...続きを読む


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング

価格.com 格安SIM 料金比較