戻る  □一般操作のサロン  □ 使用方法  □ 新着記事  □ 新規に質問する!  □ トピック一覧  □ 検索  □ 過去ログ

■ 24時間以内に投稿された新着記事 10件です。



    [191192] Re[1]: プリンターの指定方法
    ■■
    □投稿者/ ぴんく -(2020/01/24(21:58))
    □U R L/

      参考に
      Sub Test()
          Dim myPrinter As String
          myPrinter = Application.ActivePrinter   'アクティブプリンターを記録
          Worksheets("Sheet1").PrintOut ActivePrinter:="一覧で表示されるプリンター名"
          '印刷が終わるとアクティブプリンターに戻す
          Application.ActivePrinter = myPrinter
      End Sub
      


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [191193] 各グループ毎の行入替
    ■■
    □投稿者/ みらくる -(2020/01/25(12:56))
    □U R L/

      お世話になります。
      4行4列のグループの観測データ(1組)が行方向に複数組連続しています。
      選択したグループに対して1行目と2行目、3行目と4行目を入れ替えたいです。
      入れ替えたいグループの一番上の点名を選択してからマクロを実行する方法
      としたいです。
      
      @グループ2の一番上の点名「B1」を選択してからマクロ実行した場合
      
      マクロ実行前
      
      グループ名	点名	観測種別	水平角60進数
      グループ1	B1	r1001	359.5955 
      グループ1	T7	r1002	294.0635 
      グループ1	T7	l1002	114.0640 
      グループ1	B1	l1001	180.0000 
      グループ2	7B239	r1001	0.0000 
      グループ2	T1	r1002	172.3700 
      グループ2	T1	l1002	352.3705 
      グループ2	7B239	l1001	180.0000 
      
      マクロ実行後
      
      グループ名	点名	観測種別	水平角60進数
      グループ1	T7	r1002	294.0635 
      グループ1	B1	r1001	359.5955 
      グループ1	B1	l1001	180.0000 
      グループ1	T7	l1002	114.0640 
      グループ2	7B239	r1001	0.0000 
      グループ2	T1	r1002	172.3700 
      グループ2	T1	l1002	352.3705 
      グループ2	7B239	l1001	180.0000 
      
      Aグループ2の一番上の点名「7B239」を選択してからマクロ実行した場合
      
      マクロ実行前
      
      グループ名	点名	観測種別	水平角60進数
      グループ1	B1	r1001	359.5955 
      グループ1	T7	r1002	294.0635 
      グループ1	T7	l1002	114.0640 
      グループ1	B1	l1001	180.0000 
      グループ2	7B239	r1001	0.0000 
      グループ2	T1	r1002	172.3700 
      グループ2	T1	l1002	352.3705 
      グループ2	7B239	l1001	180.0000 
      
      マクロ実行後
      
      グループ名	点名	観測種別	水平角60進数
      グループ1	B1	r1001	359.5955 
      グループ1	T7	r1002	294.0635 
      グループ1	T7	l1002	114.0640 
      グループ1	B1	l1001	180.0000 
      グループ2	T1	r1002	172.3700 
      グループ2	7B239	r1001	0.0000 
      グループ2	7B239	l1001	180.0000 
      グループ2	T1	l1002	352.3705 
      
      以下VBAで作ってみて、F8を実行したところSet gyou1 = ActiveCell.Offset
      (0, -1).Resize(0.3).Valueの行でエラーとなります。
      どの様に対処したらよいかご教授願います。
      
      Sub 選択したグループの行入れ替え()
      
      Dim gyou1 As Range
      Dim gyou2 As Range
      Dim gyou3 As Range
      Dim gyou4 As Range
      
      MsgBox "マクロ実行前に入れ替えるグループの一番上の点名を選択してください", vbInformation
      
      If MsgBox("選択したグループの1行目と2行目、3行目と4行目を入れ替えますか?", vbYesNo + vbQuestion) = vbYes Then
      
          Set gyou1 = ActiveCell.Offset(0, -1).Resize(0.3).Value '選択したグループの1行目を範囲を変数に格納
          Set gyou2 = ActiveCell.Offset(1, -1).Resize(0.3).Value '選択したグループの1行目を範囲を変数に格納
          Set gyou3 = ActiveCell.Offset(2, -1).Resize(0.3).Value '選択したグループの1行目を範囲を変数に格納
          Set gyou4 = ActiveCell.Offset(3, -1).Resize(0.3).Value '選択したグループの1行目を範囲を変数に格納
          
          ActiveCell.Offset(0, -1).Resize(0.3).Value = gyou2 '入替前の2行目を1行目に配置
          ActiveCell.Offset(1, -1).Resize(0.3).Value = gyou1 '入替前の1行目を2行目に配置
          ActiveCell.Offset(2, -1).Resize(0.3).Value = gyou4 '入替前の4行目を3行目に配置
          ActiveCell.Offset(3, -1).Resize(0.3).Value = gyou3 '入替前の3行目を4行目に配置
          
          MsgBox "選択したグループの1行目と2行目、3行目と4行目を入れ替えました", vbInformation
      
      End If
      
      End Sub
      


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [191194] Re[1]: 各グループ毎の行入替
    ■■
    □投稿者/ みらくる -(2020/01/25(13:01))
    □U R L/


      すみません。質問に間違いがありましたので訂正いたします。


      @グループ2の一番上の点名「B1」を選択してからマクロ実行した場合・・誤り

                    ↓

      @グループ1の一番上の点名「B1」を選択してからマクロ実行した場合・・正



    [191195] Re[2]: 各グループ毎の行入替
    ■■
    □投稿者/ みらくる -(2020/01/25(13:06))
    □U R L/

      すみません。再度質問に間違いがありましたので訂正いたします。
      (コメントの間違い)
      
       Set gyou1 = ActiveCell.Offset(0, -1).Resize(0.3).Value '選択したグループの1行目を範囲を変数に格納
          Set gyou2 = ActiveCell.Offset(1, -1).Resize(0.3).Value '選択したグループの1行目を範囲を変数に格納
          Set gyou3 = ActiveCell.Offset(2, -1).Resize(0.3).Value '選択したグループの1行目を範囲を変数に格納
          Set gyou4 = ActiveCell.Offset(3, -1).Resize(0.3).Value '選択したグループの1行目を範囲を変数に格納
      
                   ↓
      
       Set gyou1 = ActiveCell.Offset(0, -1).Resize(0.3).Value '選択したグループの1行目の範囲を変数に格納
          Set gyou2 = ActiveCell.Offset(1, -1).Resize(0.3).Value '選択したグループの2行目の範囲を変数に格納
          Set gyou3 = ActiveCell.Offset(2, -1).Resize(0.3).Value '選択したグループの3行目の範囲を変数に格納
          Set gyou4 = ActiveCell.Offset(3, -1).Resize(0.3).Value '選択したグループの4行目の範囲を変数に格納
      
      
      


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [191196] Re[3]: 各グループ毎の行入替
    ■■
    □投稿者/ ぴんく -(2020/01/25(13:42))
    □U R L/

      参考に
      Sub 選択したグループの行入れ替え()
          Dim gyou1 As Variant
          Dim gyou2 As Variant
          Dim gyou3 As Variant
          Dim gyou4 As Variant
      
          MsgBox "マクロ実行前に入れ替えるグループの一番上の点名を選択してください", vbInformation
          If MsgBox("選択したグループの1行目と2行目、3行目と4行目を入れ替えますか?", vbYesNo + vbQuestion) = vbYes Then
              gyou1 = ActiveCell.Offset(0, -1).Resize(1, 4).Value     '選択したグループの1行目を範囲を変数に格納
              gyou2 = ActiveCell.Offset(1, -1).Resize(1, 4).Value     '選択したグループの2行目を範囲を変数に格納
              gyou3 = ActiveCell.Offset(2, -1).Resize(1, 4).Value     '選択したグループの3行目を範囲を変数に格納
              gyou4 = ActiveCell.Offset(3, -1).Resize(1, 4).Value     '選択したグループの4行目を範囲を変数に格納
              ActiveCell.Offset(0, -1).Resize(1, 4).Value = gyou2     '入替前の2行目を1行目に配置
              ActiveCell.Offset(1, -1).Resize(1, 4).Value = gyou1     '入替前の1行目を2行目に配置
              ActiveCell.Offset(2, -1).Resize(1, 4).Value = gyou4     '入替前の4行目を3行目に配置
              ActiveCell.Offset(3, -1).Resize(1, 4).Value = gyou3     '入替前の3行目を4行目に配置
              MsgBox "選択したグループの1行目と2行目、3行目と4行目を入れ替えました", vbInformation
          End If
      End Sub
      


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [191197] Re[4]: 各グループ毎の行入替
    ■■
    □投稿者/ ぴんく -(2020/01/25(14:05))
    □U R L/

      少し整理しました
      Sub 選択したグループの行入れ替え2()
          Dim gyou(1 To 4)
      
          MsgBox "マクロ実行前に入れ替えるグループの一番上の点名を選択してください", vbInformation
          If MsgBox("選択したグループの1行目と2行目、3行目と4行目を入れ替えますか?", vbYesNo + vbQuestion) = vbYes Then
              With ActiveCell
                  gyou(1) = .Offset(0, -1).Resize(1, 4).Value         '選択したグループの1行目を範囲を変数に格納
                  gyou(2) = .Offset(1, -1).Resize(1, 4).Value         '選択したグループの2行目を範囲を変数に格納
                  gyou(3) = .Offset(2, -1).Resize(1, 4).Value         '選択したグループの3行目を範囲を変数に格納
                  gyou(4) = .Offset(3, -1).Resize(1, 4).Value         '選択したグループの4行目を範囲を変数に格納
              
                  .Offset(0, -1).Resize(1, 4).Value = gyou(2)         '入替前の2行目を1行目に配置
                  .Offset(1, -1).Resize(1, 4).Value = gyou(1)         '入替前の1行目を2行目に配置
                  .Offset(2, -1).Resize(1, 4).Value = gyou(4)         '入替前の4行目を3行目に配置
                  .Offset(3, -1).Resize(1, 4).Value = gyou(3)         '入替前の3行目を4行目に配置
                  MsgBox "選択したグループの1行目と2行目、3行目と4行目を入れ替えました", vbInformation
              End With
          End If
      End Sub
      


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [191198] Re[5]: 各グループ毎の行入替
    ■■
    □投稿者/ ぴんく -(2020/01/25(14:44))
    □U R L/

      Sub 選択したグループの行入れ替え3()
          Dim v As Variant
          
          MsgBox "マクロ実行前に入れ替えるグループの一番上の点名を選択してください", vbInformation
          If MsgBox("選択したグループの1行目と2行目、3行目と4行目を入れ替えますか?", vbYesNo + vbQuestion) = vbYes Then
              With ActiveCell
                  v = .Offset(0, -1).Resize(4, 4).Value                           '選択したグループの4行分を変数に格納
              
                  .Offset(0, -1).Resize(1, 4).Value = Application.Index(v, 2, 0)  '入替前の2行目を1行目に配置
                  .Offset(1, -1).Resize(1, 4).Value = Application.Index(v, 1, 0)  '入替前の1行目を2行目に配置
                  .Offset(2, -1).Resize(1, 4).Value = Application.Index(v, 4, 0)  '入替前の4行目を3行目に配置
                  .Offset(3, -1).Resize(1, 4).Value = Application.Index(v, 3, 0)  '入替前の3行目を4行目に配置
                  MsgBox "選択したグループの1行目と2行目、3行目と4行目を入れ替えました", vbInformation
              End With
          End If
      End Sub
      


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [191199] Re[5]: 各グループ毎の行入替
    ■■
    □投稿者/ みらくる -(2020/01/25(14:49))
    □U R L/

      ぴんく様
      早速のご回答誠にありがとうございました。
      ぴんく様2種のマクロを実行したところ、やりたい操作ができました。
      今まで、ActiveCellとResizeを同時に使う方法がわかりませんでした。
      今回、その変数はオブジェクト変数でなくバリアントとする点が大変勉強
      になりました。今後もいろいろな場面で利用できそうです。
      
      別案として以下のコードでもうまくできました。
      RangeとCellsの組合せは今まで範囲指定多用していましたが、ぱっと見わ
      かりにくいですね。
      変数を使えば以下コードのコピーとクリアの操作は不要となると思いますが、
      自分にはできなかったです。
      
      ぴんく様のコードを採用いたします。
      
      Sub 選択したグループの行入れ替え()
      
      Dim i As Integer
      Dim j As Integer
      
      MsgBox "マクロ実行前に入れ替えるグループの一番上の点名を選択してください", vbInformation
      
      i = ActiveCell.Row
      j = ActiveCell.Column
      
      If MsgBox("選択したグループの1行目と2行目、3行目と4行目を入れ替えますか?", vbYesNo + vbQuestion) = vbYes Then
      
          '入替前全体を右側へコピー(作業用)
          Range(Cells(i + 0, j - 1), Cells(i + 3, j + 2)).Copy Range(Cells(i + 0, j + 3), Cells(i + 3, j + 6))
          
          '選択グループの行入替(入替前全体からコピー)
          Range(Cells(i + 1, j + 3), Cells(i + 1, j + 6)).Copy Range(Cells(i + 0, j - 1), Cells(i + 0, j + 2))
          Range(Cells(i + 0, j + 3), Cells(i + 0, j + 6)).Copy Range(Cells(i + 1, j - 1), Cells(i + 1, j + 2))
          Range(Cells(i + 3, j + 3), Cells(i + 3, j + 6)).Copy Range(Cells(i + 2, j - 1), Cells(i + 2, j + 2))
          Range(Cells(i + 2, j + 3), Cells(i + 2, j + 6)).Copy Range(Cells(i + 3, j - 1), Cells(i + 3, j + 2))
      
          '入替前全体(作業用)をクリア
          Range(Cells(i + 0, j + 3), Cells(i + 3, j + 6)).Clear
      
          MsgBox "選択したグループの1行目と2行目、3行目と4行目を入れ替えました", vbInformation
      
      End If
      
      End Sub
      


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [191200] Re[6]: 各グループ毎の行入替
    ■■
    □投稿者/ みらくる -(2020/01/25(15:11))
    □U R L/


      ぴんく様

      3番目のご回答コードは自分の理解を超越しています。
      コードをコンパクトにするために、いろいろな方法があるのですね。
      ひとまず1番目または2番目のご回答コードの方法を利用いたします。

      ありがとうございました。




    [191201] Re[7]: 各グループ毎の行入替
    ■1■
    □投稿者/ みらくる -(2020/01/25(15:28))
    □U R L/


      解決にチェック入れるのを忘れていました。


- Child Forum -
Edit:ゆう-G