前回と同じく簡単入力のマクロについての質問です。


Sub SELECT_AC()
修正行 = 0

If ActiveSheet.Name = "DATA" Then
GYOU = ActiveCell.Row
修正行 = GYOU
RETU = Worksheets("入力").Range("a5").CurrentRegion.Count
For I = 1 To RETU
j = I + 3
Worksheets("入力").Cells(j, 2) = Worksheets("DATA").Cells(GYOU, I).Value
Next I
Sheets("入力").Select

ss = Str(修正行)
If 状態 = "修正" Then Range("b2") = ss & " 行目 修正中"
If 状態 = "流用" Then Range("b2") = ss & " 行目 流用中"

Range("B4").Select
End If

End Sub

--------------------------------------
入力シートのA列とB列の間に1行増やしたいのですがうまくいきません。どう直せばいいのでしょうか?
また、このマクロを詳しく解説していただきましたら助かります。

回答の条件
  • URL必須
  • 1人2回まで
  • 登録:2007/10/02 15:25:37
  • 終了:2007/10/04 13:56:12

ベストアンサー

id:Mook No.1

Mook回答回数1312ベストアンサー獲得回数3912007/10/02 16:12:21

ポイント35pt

シートの書式を変えると、いろいろなところに影響がでるので、気をつけて作業をして下さい。


この処理に関しては下記のように変更になります。

Sub SELECT_AC()
    修正行 = 0

    If ActiveSheet.Name = "DATA" Then
        GYOU = ActiveCell.Row
        修正行 = GYOU
        RETU = Worksheets("入力").Range("a5").CurrentRegion.Count
        For I = 1 To RETU
            j = I + 3
            Worksheets("入力").Cells(j, 3) = Worksheets("DATA").Cells(GYOU, I).Value
        Next I
        Sheets("入力").Select
        
        ss = Str(修正行)
        If 状態 = "修正" Then Range("C2") = ss & " 行目 修正中"
        If 状態 = "流用" Then Range("C2") = ss & " 行目 流用中"
        
        Range("C4").Select
    End If
End Sub

気をつけてみるべき場所は Cells と Range です。

A列とB列の間に一行つかするならば、「入力シート」DATAシートは変更しない)のB列以降の

Range の最初のアルファベット部分をB以降一つずつずらします。

例:
    Range("B2")⇒Range("C2")
    Range("C5")⇒Range("D5")
    Range("D7")⇒Range("E7")

また、Cells の後ろの数値も一つずつ増やします。

例:
    Cells( 2, 2 )⇒Cells( 2, 3 )
    Cells( j, 2 )⇒Cells( j, 3 )
    Cells( GYOU, I )⇒Cells( GYOU, I + 1 )

※入力シートに関する部分は他の処理もすべて同様の変更が必要です。



セル関連の基本的なマクロ(範囲指定、セルに入力、値の取得)

その他の回答(1件)

id:Mook No.1

Mook回答回数1312ベストアンサー獲得回数3912007/10/02 16:12:21ここでベストアンサー

ポイント35pt

シートの書式を変えると、いろいろなところに影響がでるので、気をつけて作業をして下さい。


この処理に関しては下記のように変更になります。

Sub SELECT_AC()
    修正行 = 0

    If ActiveSheet.Name = "DATA" Then
        GYOU = ActiveCell.Row
        修正行 = GYOU
        RETU = Worksheets("入力").Range("a5").CurrentRegion.Count
        For I = 1 To RETU
            j = I + 3
            Worksheets("入力").Cells(j, 3) = Worksheets("DATA").Cells(GYOU, I).Value
        Next I
        Sheets("入力").Select
        
        ss = Str(修正行)
        If 状態 = "修正" Then Range("C2") = ss & " 行目 修正中"
        If 状態 = "流用" Then Range("C2") = ss & " 行目 流用中"
        
        Range("C4").Select
    End If
End Sub

気をつけてみるべき場所は Cells と Range です。

A列とB列の間に一行つかするならば、「入力シート」DATAシートは変更しない)のB列以降の

Range の最初のアルファベット部分をB以降一つずつずらします。

例:
    Range("B2")⇒Range("C2")
    Range("C5")⇒Range("D5")
    Range("D7")⇒Range("E7")

また、Cells の後ろの数値も一つずつ増やします。

例:
    Cells( 2, 2 )⇒Cells( 2, 3 )
    Cells( j, 2 )⇒Cells( j, 3 )
    Cells( GYOU, I )⇒Cells( GYOU, I + 1 )

※入力シートに関する部分は他の処理もすべて同様の変更が必要です。



セル関連の基本的なマクロ(範囲指定、セルに入力、値の取得)

id:taknt No.2

きゃづみぃ回答回数13537ベストアンサー獲得回数11982007/10/02 17:03:53

ポイント35pt

>また、このマクロを詳しく解説していただきましたら助かります。

質問にあるマクロを 詳しく説明します。

修正行 = 0

修正行という変数に0をセットします。

If ActiveSheet.Name = "DATA" Then

アクティブになっているシート名が "DATA"の時に End If までの処理をします。

質問のマクロでは すべてですが。

GYOU = ActiveCell.Row

選択中のセルの行番号を GYOUという変数にセットします。

RETU = Worksheets("入力").Range("a5").CurrentRegion.Count

入力のシートのA5セル近辺のアクティブ セル領域の数をRETUの変数にセットします。

For I = 1 To RETU

その RETUの数分を Next I まで ループ処理します。

j = I + 3

Jに I+3をセットします。Iは ループの数で 一回ループするごとに +1 されます。

Worksheets("入力").Cells(j, 2) = Worksheets("DATA").Cells(GYOU, I).Value

入力のシートのセルに DATAのシートのセルの値を セットします。

入力側の行と列は jと2

DATA側の行と列は GYOUとI



Sheets("入力").Select

入力シートを選択します。


ss = Str(修正行)

修正行の値を文字列にします。

後ほど、文字列と連結するために 変換しています。

If 状態 = "修正" Then Range("b2") = ss & " 行目 修正中"

状態の変数の値が "修正" ならば B2のセルに ss & " 行目 修正中" をセットします。

If 状態 = "流用" Then Range("b2") = ss & " 行目 流用中"

状態の変数の値が "流用" ならば B2のセルに ss & " 行目 流用中" をセットします。


http://q.hatena.ne.jp/1191306336

  • id:Mook
    イルカ賞ありがとうございました。

    変更の方はうまくいきましたか?
    なにか問題あればコメントで対応しますので、お書きください。
  • id:mika555
    こんにちは、いつもありがとうございます。
    気がついたのですが、修正作業を行った後、まったく新しいデータを登録しようとすると、DATAシートの既存の行を誤変更してしまう
    場合があることに気がつきました。シートを分ければ解決しそうですが、もう実際に作業する方が使いやすい方法があれば教えて下さい。

    現在のシート構成ですが
    DATAシート×1、入力シート×1
    作業する人間はA行に対し新規入力者は1名、自分の部署が管理するデータを入力(編集する人間)は4名(新規入力者も修正作業は
    行います)
    流用や項目消去の機能は削除しました。よろしくお願いします。
  • id:Mook
    他の関数の処理も変更しなければなりませんが、そちらは変更したでしょうか。

    怪しそうなのは、「転記」ですがオリジナルコードでは4箇所修正する必要があります。

    特に
     Range("B4:B" & owari_g).Select
           ↓
     Range("C4:C" & owari_g).Select
    のように修正する必要がありますが、そのようになっているでしょうか。
  • id:mika555
    Sub 転記()
    '
    ' 転記 Macro
    '

    Application.ScreenUpdating = False
    '
    If Range("C4") = "" Or Range("C5") = "" Then
    MsgBox "氏名コードか氏名が未入力です。"
    Range("C4").Select
    End
    End If

    If 修正行 > 0 And 状態 = "修正" Then
    GYOU = 修正行
    End If

    If 修正行 = 0 Then
    GYOU = Worksheets("DATA").Range("A4").CurrentRegion.Rows.Count + 4
    End If

    Sheets("入力").Select
    owari_g = Range("a4").CurrentRegion.Rows.Count + 3
    Range("c4:c" & owari_g).Select
    Selection.Copy
    Sheets("DATA").Select
    Range("A" & GYOU).Select
    Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
    , Transpose:=True
    Sheets("入力").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("C5").Formula = "=PHONETIC(C4)"
    Range("c2").ClearContents
    Range("C4").Select
    End Sub

    と、しましたがいかがでしょう?
  • id:Mook
    見た感じよさそうです。
    PHONETIC もよく気が付きましたね。

    実際にご変更が起こる列は(データ範囲)はどこでしょうか。
  • id:mika555
    入力シートは
    DATAシートはA5:BO(無限)です。
    本来の簡単入力でも修正した後に新規入力すると直前に修正した
    行が書き換わってしまいます。
    ここをどうにか克服しないと実運用はできそうにありません。
    お力を頂けたら幸いです。
  • id:Mook
    もしかして不具合というのは、上記の現象のことでしょうか。
    これは今回の修正が原因ではなく、もともとのプログラムの仕様のようです。
    (ボタンを正しく操作しないとそういう挙動になります。)


    今回、流用と項目消去のボタンを削除したのであれば、
    マクロを下記に書き換えてみてどうでしょうか。
    ------------------------------------------------------------
    Dim 状態 As String
    Dim 修正行 As Long

    Sub AUTO_OPEN()
      InitForm
    End Sub
    Sub InitForm()
      Sheets("入力").Select

      Range("C4:C" & Range("A4").CurrentRegion.Rows.Count + 3).ClearContents
      Range("C5").Formula = "=PHONETIC(C4)"
      Range("C2").ClearContents
      Range("C4").Select
      状態 = ""
    End Sub

    Sub 転記()
      If Range("C4") = "" Or Range("C10") = "" Then
        MsgBox "氏名か電話番号が未入力です。"
        Range("C4").Select
        Exit Sub
      End If

      Dim cLine As Long
      If 修正行 > 0 And 状態 = "修正" Then
        cLine = 修正行
      Else
        cLine = Worksheets("DATA").Range("A4").CurrentRegion.Rows.Count + 4
      End If
      Sheets("入力").Range("C4:C" & Range("A4").CurrentRegion.Rows.Count + 3).Copy
      Sheets("DATA").Range("A" & cLine).PasteSpecial _
        Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
      Application.CutCopyMode = False
      InitForm
    End Sub

    Sub SELECT_AC()
      If ActiveSheet.Name <> "DATA" Then
        修正行 = 0
        状態 = ""
        Exit Sub
      End If

      修正行 = ActiveCell.Row
      Dim cLine As Long
      cLine = Worksheets("入力").Range("A5").CurrentRegion.Count
      For I = 1 To cLine
        j = I + 3
        Worksheets("入力").Cells(j, 3) = Worksheets("DATA").Cells(修正行, I).Value
      Next I
      Sheets("入力").Range("C2") = Str(修正行) & " 行目 修正中"
      状態 = "修正"
      Sheets("入力").Activate
      Range("C4").Select
    End Sub

    Sub dataシートへ()
      Worksheets("DATA").Select
      Range("B1") = "修正する場合は、該当するデータ行で、ダブルクリックして下さい。"
      Range("A5").Select
    End Sub

    Sub 初期項目設定()
      If MsgBox("A列の項目をDATAシートへ転記します。" & Chr(13) & _
        " DATAシートの元の項目はなくなります。", vbOKCancel, "初期項目設定") = vbCancel Then
        Exit Sub
      End If

      Sheets("入力").Select
      Range("A4:A" & Range("A4").CurrentRegion.Rows.Count + 4).Copy
      Sheets("DATA").Range("A4").PasteSpecial _
        Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True

      Application.CutCopyMode = False
      Range("A4").Select
    End Sub
    ------------------------------------------------------------
  • id:mika555
    大変ありがとうございました。
    プレ稼動はじめました。
    これからもよろしくお願いします。
    これの次の段階の質問をたてますのでまたよろしくお願いします。

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

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

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

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