ここで教えていただいた記述をバージョンアップさせたいです。
仕様と記述
1.インプットBOX-1
「対象値のある列を入力してください」
入力例:G
↓↓
2.メッセージボックス
「列挿入しそこに転記しますか?」
YES/NO 選択
↓↓
3.YESの場合
インプットBOX-2
「挿入したい列を入力してください。例:H列とI列の間→H」
入力例:H
NOの場合
インプットBOX-3
「転記する列を入力してください」
入力例:J
インプットBOX-1に入力された値の列を対象列として
Select Caseの条件で編集して
インプットBOX-2又は3に入力された値の列に転記します。
対象列にデータがあるまで処理を繰り返します。
バージョンアップさせたい内容
(1)
インプットBOX-1,2,3はエクセルの列の入力なので
A~IV以外の入力はエラーとして
「入力値が違います。A~IV のいずれかを入力してください。再入力しますか?」
でOKをクリックすると再入力可能に
(2)
インプットBOX-2
インプットBOX-1で入力した値より前の値はエラーとする
「対象列がずれます。●●以外を入力してください。再入力しますか?」
OKをクリックで再入力可能に。
例:インプットBOX-1にCと入力した場合A,B,Cはエラー
となる。●●の所にその値を表示する。
(3)
インプットBOX-3
インプットBOX-1で入力した値と同じ値の場合はエラーとする。
「対象列の元の値が削除されたてしまいます。●●以外を入力してください。再入力しますか?」
OKをクリックで再入力可能に。
例:インプットBOX-1にCと入力した場合Cはエラーとなる。
●●の所にその値を表示する。
(1)(2)(3)の記述を教えてください。お願いします。
以下が現在の記述です。
↓↓↓
Sub ハイフン挿入02()
'2010年11月24日
対象値列 = InputBox("対象値のある列を入力してください")
列挿入 = MsgBox("列挿入しそこに転記しますか?", vbYesNo)
If 列挿入 = vbYes Then
転記列 = InputBox("挿入したい列を入力してください。例:H列とI列の間→H")
Else
転記列 = InputBox("転記する列を入力してください")
End If
If 列挿入 = vbYes Then
Columns(転記列).Insert Shift:=xlToRight
End If
'データは2行目からの事
行 = 2
Do
'対象値列にデータがあるまで繰り返す
n = Cells(行, 1).Value
If n = "" Then Exit Do
'対象列は14文字である事
If Len(n) = 14 Then
Select Case True
'左2字=9X & -が無
Case Left(n, 2) = "9X" And InStr(n, "-") = 0
'3-11で編集
myStr = Left(n, 3) & "-" & Mid(n, 4)
'9字目が-
Case Mid(n, 9, 1) = "-"
'3-5-5で編集
myStr = Left(n, 3) & "-" & Mid(n, 4, 11)
'左1字=9 & -が無
Case Left(n, 1) = "9" And InStr(n, "-") = 0
'5-5-2-2で編集
myStr = Left(n, 5) & "-" & Mid(n, 6, 5) & "-" & Mid(n, 11, 2) & "-" & Mid(n, 13, 2)
'-が無
Case InStr(n, "-") = 0
'3-5-2-2で編集
myStr = Left(n, 3) & "-" & Mid(n, 4, 5) & "-" & Mid(n, 9, 2) & "-" & Mid(n, 11, 2) & "-" & Mid(n, 13, 2)
'いずれにも属さない14文字
Case Else
'編集対象の値を使用する(未編集)
myStr = n
End Select
'編集対象の値が14文字でない
Else
'編集対象の値を使用する(未編集)
myStr = n
End If
Cells(行, 転記列) = myStr
行 = 行 + 1
Loop
End Sub
No.4ベストアンサー
- 回答日時:
ご質問の部分(さっきのEndの前)しか見ていなかったのですが、
ご提示の
> 行 = 2
> Do
> '対象値列にデータがあるまで繰り返す
> n = Cells(行, 1).Value
だと、いくら対象列を選んでも、これじゃA列のデータしかみてないですよ。
あと、列の挿入位置が違ったようでそれも修正しました。
> また連続操作が出来ません。
意味不明。
Sub ハイフン挿入05()
Dim 対象値列 As Range, 転記列 As Range
Dim myStr As String, n As String
Dim 列挿入 As Integer
Dim 行 As Long, c(1) As Long
On Error Resume Next
Set 対象値列 = Application.InputBox("対象値のある列をマウスで選択してください", "必ず選択", Type:=8)
On Error GoTo 0
If 対象値列 Is Nothing Then
MsgBox "きゃんせる", , "ヾ( ̄□ ̄; )ノ"
Exit Sub
End If
c(0) = 対象値列.Column
列挿入 = MsgBox("列挿入し、そこに転記しますか?", vbYesNo + vbQuestion, "(^∇^)?")
line01:
If 列挿入 = vbYes Then
On Error Resume Next
Set 転記列 = Application.InputBox("挿入したい列の次の列をマウスで選択してください。" & _
vbNewLine & "例:H列とI列の間→I列を選択", "必ず選択", Type:=8)
On Error GoTo 0
If 転記列 Is Nothing Then
MsgBox "きゃんせる", , "ヾ( ̄□ ̄; )ノ"
Exit Sub
End If
If 転記列.Column <= c(0) Then
MsgBox "対象列がずれます。" & 対象値列.Address(0, 0) & "より右を選択してください。", vbCritical, "Σ( ̄ロ ̄lll) "
GoTo line01
End If
Else
On Error Resume Next
Set 転記列 = Application.InputBox("転記する列をマウスで選択してください。", "必ず選択", Type:=8)
On Error GoTo 0
If 転記列 Is Nothing Then
MsgBox "きゃんせる", , "ヾ( ̄□ ̄; )ノ"
Exit Sub
End If
If 転記列.Column = c(0) Then
MsgBox "対象列の元の値が削除されてしまいます。" & 対象値列.Address(0, 0) & "以外を選択してください。", vbCritical, "Σ( ̄ロ ̄lll)"
GoTo line01
End If
End If
c(1) = 転記列.Column
If 列挿入 = vbYes Then
Columns(c(1)).Insert Shift:=xlToRight
End If
行 = 2
Do
n = Cells(行, c(0)).Value
If n = "" Then Exit Do
If Len(n) = 14 Then
Select Case True
Case Left(n, 2) = "9X" And InStr(n, "-") = 0
myStr = Left(n, 3) & "-" & Mid(n, 4)
Case Mid(n, 9, 1) = "-"
myStr = Left(n, 3) & "-" & Mid(n, 4, 11)
Case Left(n, 1) = "9" And InStr(n, "-") = 0
myStr = Left(n, 5) & "-" & Mid(n, 6, 5) & "-" & Mid(n, 11, 2) & "-" & Mid(n, 13, 2)
Case InStr(n, "-") = 0
myStr = Left(n, 3) & "-" & Mid(n, 4, 5) & "-" & Mid(n, 9, 2) & "-" & Mid(n, 11, 2) & "-" & Mid(n, 13, 2)
Case Else
myStr = n
End Select
Else
myStr = n
End If
Cells(行, c(1)) = myStr
行 = 行 + 1
Loop
End Sub
>だと、いくら対象列を選んでも、これじゃA列のデータしかみてないですよ。
確かにそうです。申し訳ありません。m(__)m
意地悪テストでの誤動作はこれが原因でした。
>> また連続操作が出来ません。
>意味不明。
これも上記が原因でした。忘れてください。m(__)m
05は、
全ての条件において完璧でした。
どうもありがとうございました。
No.5
- 回答日時:
gx9wxさん こんにちは。
正直このスペースでの回答を厳しいですが、入力の部分だけを対応してみました。
※列の入力チェックは(1)だけではなく(2)(3)も必要だと思います。
※(2)のエラーメッセージ(「対象列がずれます。●●以外を…)も違うと思いますが…。
※InputBoxで「キャンセル」ボタンの対応はしていません。
下記のサンプルをベースに、細かな所はgx9wxさんで修正してください。
Sub ハイフン挿入02()
Const 対象列mess = "対象値のある列を入力してください"
Const 列挿入mess = "列挿入しそこに転記しますか?"
Const 転記列mess = "転記する列を入力してください"
Const 転記挿入mess = "挿入したい列を入力してください。例:H列とI列の間→H"
Const 転記列Emess = "対象列の元の値が削除されてしまいます。@列以外を入力してください。再入力しますか?"
Const 転記挿入Emess = "対象列がずれます。@列以降を入力してください。再入力しますか?"
Do
If 列入力(対象列mess, 対象値列, 対象値列NO) = False Then Exit Sub
列挿入 = MsgBox(列挿入mess, vbYesNo)
If 列挿入 = vbYes Then
If 列入力(転記挿入mess, 転記列, 転記列NO) = False Then Exit Sub
If 転記列NO <= 対象値列NO Then
If MsgBox(Format(UCase(対象値列), 転記挿入Emess), vbYesNo) = vbNo Then Exit Sub
Else
Exit Do
End If
Else
If 列入力(転記列mess, 転記列, 転記列NO) = False Then Exit Sub
If 転記列NO = 対象値列NO Then
If MsgBox(Format(UCase(対象値列), 転記列Emess), vbYesNo) = vbNo Then Exit Sub
Else
Exit Do
End If
End If
Loop
:
:
End Sub
Function 列入力(メッセージ, 列番号, 列番号NO) As Boolean
On Error Resume Next
Do
列入力 = True
列番号 = UCase(InputBox(メッセージ))
Err.Clear
列番号NO = Cells(1, 列番号).Column
If Err.Number = 0 Then Exit Function
列入力 = False
If MsgBox("入力値が違います。A~IV のいずれかを入力してください。再入力しますか?", vbYesNo) = vbNo Then Exit Function
Loop
End Function
Function
はまだまったく理解していない為、
>細かな所はgx9wxさんで修正してください。
とても修正が出来ません。申し訳ありません。
また列挿入がされない為
Columns(転記列).Insert Shift:=xlToRight
をどこかに入れるのでは?と思うのですが
それもわかりません。
お時間をとっていただきありがとうございました。
No.3
- 回答日時:
> Endが怪しいと思い、
> 削除したら思ったように動きました。
ごめんごめん、お尋ねになったこととは無関係な部分を止めてました。
消すのをわすれちゃった。
(*/o\*)恥ずかしい・・・。
この回答への補足
すいません。
データの問題のようです。
A~F列にデータがあって
手動で
A列に挿入し
A列がB列になった状態で
マクロを走らせると、おかしな動きになります。
通常はこのような事はありませんので
私の操作ミスです。
お騒がせしました。
ありがとうございます。
03も04も
列挿入→No
で列を指定すると
どこかの列を指定列にコピーするみたいです。
で不思議なのはその処理が終了した状態でそのシートで
02を走らせると、02も03,04と同じ動きになってしまう事です。
ちょっと混乱しています。
No.2
- 回答日時:
すみません、さきほどのコードはキャンセル処理がいいかげんでした。
修正しましたが、文字数制限に引っかかったので、コメントとインデントはすべて消しました。
あしからず。
Sub ハイフン挿入04()
Dim 対象値列 As Range, 転記列 As Range
Dim myStr As String, n As String
Dim 列挿入 As Integer
Dim 行 As Long, c(1) As Long
On Error Resume Next
Set 対象値列 = Application.InputBox("対象値のある列をマウスで選択してください", "必ず選択", Type:=8)
On Error GoTo 0
If 対象値列 Is Nothing Then
MsgBox "きゃんせる", , "ヾ( ̄□ ̄; )ノ"
Exit Sub
End If
c(0) = 対象値列.Column
列挿入 = MsgBox("列挿入しそこに転記しますか?", vbYesNo + vbQuestion, "(^∇^)?")
line01:
If 列挿入 = vbYes Then
On Error Resume Next
Set 転記列 = Application.InputBox("挿入したい列の前列をマウスで選択してください。" & _
vbNewLine & "例:H列とI列の間→Hを選択", "必ず選択", Type:=8)
On Error GoTo 0
If 転記列 Is Nothing Then
MsgBox "きゃんせる", , "ヾ( ̄□ ̄; )ノ"
Exit Sub
End If
If 転記列.Column <= c(0) Then
MsgBox "対象列がずれます。" & 対象値列.Address(0, 0) & "より右を選択してください。", vbCritical, "Σ( ̄ロ ̄lll) "
GoTo line01
End If
Else
On Error Resume Next
Set 転記列 = Application.InputBox("転記する列をマウスで選択してください。", "必ず選択", Type:=8)
On Error GoTo 0
If 転記列 Is Nothing Then
MsgBox "きゃんせる", , "ヾ( ̄□ ̄; )ノ"
Exit Sub
End If
If 転記列.Column = c(0) Then
MsgBox "対象列の元の値が削除されてしまいます。" & 対象値列.Address(0, 0) & "以外を選択してください。", vbCritical, "Σ( ̄ロ ̄lll)"
GoTo line01
End If
End If
c(1) = 転記列.Column
If 列挿入 = vbYes Then
Columns(c(1)).Insert Shift:=xlToRight
End If
End
行 = 2
Do
n = Cells(行, 1).Value
If n = "" Then Exit Do
If Len(n) = 14 Then
Select Case True
Case Left(n, 2) = "9X" And InStr(n, "-") = 0
myStr = Left(n, 3) & "-" & Mid(n, 4)
Case Mid(n, 9, 1) = "-"
myStr = Left(n, 3) & "-" & Mid(n, 4, 11)
Case Left(n, 1) = "9" And InStr(n, "-") = 0
myStr = Left(n, 5) & "-" & Mid(n, 6, 5) & "-" & Mid(n, 11, 2) & "-" & Mid(n, 13, 2)
Case InStr(n, "-") = 0
myStr = Left(n, 3) & "-" & Mid(n, 4, 5) & "-" & Mid(n, 9, 2) & "-" & Mid(n, 11, 2) & "-" & Mid(n, 13, 2)
Case Else
myStr = n
End Select
Else
myStr = n
End If
Cells(行, c(1)) = myStr
行 = 行 + 1
Loop
End Sub
ありがとうございます。
03同様に
End If
End
行 = 2
Do
の
Endを削除したら動きました。
・最初対象列をC列にします。
・挿入→No
・転記列選択
・C列→ERR(正)
・D列選択→編集はされずどこかの列の値をコピーします(NG)
また連続操作が出来ません。
・対象列をB列
・挿入選択
・D列→成功
・そのシートで再マクロ
・対象列をB列
・挿入選択
・F列→どこかの列の値がコピーされます。
これは03も同じでした。
連続動作ですが02は大丈夫でした。
私の操作が違っているのかも知れません。
もう少しやってみます。
No.1
- 回答日時:
こんにちは。
> (1)
> インプットBOX-1,2,3はエクセルの列の入力なので
> A~IV以外の入力はエラーとして
ならば、最初からRangeしか入らないようにして、マウスで選択させたら?
こんな感じ?
Sub ハイフン挿入03()
Dim 対象値列 As Range, 転記列 As Range
Dim myStr As String, n As String
Dim 列挿入 As Integer
Dim 行 As Long, c(1) As Long
Set 対象値列 = Application.InputBox("対象値のある列をマウスで選択してください", "必ず選択", Type:=8)
If 対象値列 Is Nothing Then MsgBox "きゃんせる"
c(0) = 対象値列.Column
列挿入 = MsgBox("列挿入しそこに転記しますか?", vbYesNo + vbQuestion, "(^∇^)?")
line01:
If 列挿入 = vbYes Then
Set 転記列 = Application.InputBox("挿入したい列の前列をマウスで選択してください。" & _
vbNewLine & "例:H列とI列の間→Hを選択", "必ず選択", Type:=8)
If 転記列.Column <= c(0) Then
MsgBox "対象列がずれます。" & 対象値列.Address(0, 0) & "より右を選択してください。", vbCritical, "Σ( ̄ロ ̄lll) "
GoTo line01
End If
Else
Set 転記列 = Application.InputBox("転記する列をマウスで選択してください。", "必ず選択", Type:=8)
If 転記列.Column = c(0) Then
MsgBox "対象列の元の値が削除されてしまいます。" & 対象値列.Address(0, 0) & "以外を選択してください。", vbCritical, "Σ( ̄ロ ̄lll)"
GoTo line01
End If
End If
c(1) = 転記列.Column
If 列挿入 = vbYes Then
Columns(c(1)).Insert Shift:=xlToRight
End If
End
行 = 2
Do
n = Cells(行, 1).Value
If n = "" Then Exit Do
If Len(n) = 14 Then '対象列は14文字である事
Select Case True
Case Left(n, 2) = "9X" And InStr(n, "-") = 0 '左2字=9X & -が無
myStr = Left(n, 3) & "-" & Mid(n, 4) '3-11で編集
Case Mid(n, 9, 1) = "-" '9字目が-
myStr = Left(n, 3) & "-" & Mid(n, 4, 11) '3-5-5で編集
Case Left(n, 1) = "9" And InStr(n, "-") = 0 '左1字=9 & -が無
myStr = Left(n, 5) & "-" & Mid(n, 6, 5) & "-" & Mid(n, 11, 2) & "-" & Mid(n, 13, 2) '5-5-2-2で編集
Case InStr(n, "-") = 0 '-が無
myStr = Left(n, 3) & "-" & Mid(n, 4, 5) & "-" & Mid(n, 9, 2) & "-" & Mid(n, 11, 2) & "-" & Mid(n, 13, 2) '3-5-2-2で編集
Case Else 'いずれにも属さない14文字
myStr = n '編集対象の値を使用する(未編集)
End Select
Else '編集対象の値が14文字でない
myStr = n '編集対象の値を使用する(未編集)
End If
Cells(行, c(1)) = myStr
行 = 行 + 1
Loop
End Sub
こんにちは。
ありがとうございます。
なかなか回答がつかなかったので
マクロでの対応は無理なのかな?と思いました。
で教えていただいた記述ですが途中で動きませんでした。
End If
End
行 = 2
Do
この行=2の前の
Endが怪しいと思い、
削除したら思ったように動きました。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) VBA Userformで一部別シートに転記がしたいのですが 2 2023/05/24 13:08
- Visual Basic(VBA) 【再投稿】VBAで動作しなくて困っています 2 2022/10/11 11:05
- Visual Basic(VBA) 列と行の名前(重複あり)が交差するセルに、データを入力したい 2 2022/06/25 22:42
- Visual Basic(VBA) 3つのプロシージャをまとめたら実行時エラー発生で対応不能 6 2022/05/17 01:47
- Visual Basic(VBA) VBAのトグルボタンでのマクロについて質問です 3 2022/10/10 17:23
- Visual Basic(VBA) 【再々投稿】VBAのプログラムで動作しなくて困っています 8 2022/10/14 09:06
- Visual Basic(VBA) excel2021で実行できないマクロ。どこを直したらいいのか 2 2022/03/28 03:40
- Visual Basic(VBA) 別シートのデータを参照して値を入れたい。 まとめデータシートのC列D列の値を商品一覧シートのコードが 7 2022/08/17 13:20
- Visual Basic(VBA) VBA エクセル 条件の設定 1 2022/03/28 10:24
- Visual Basic(VBA) Changeイベントで複数セルへの貼り付けおよび値削除時に1個目のセルのみエラーになる 3 2022/12/21 09:07
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
エクセル初心者です 関数の入れ...
-
エクセルで二つの数字の小さい...
-
LOOKUP関数を使えばいいのでし...
-
PowerPointで表の1つの列だけ...
-
エクセルで最初のスペースまで...
-
エクセル 文字数 多い順 並...
-
VBAで文字列を数値に変換したい
-
2つのエクセルのデータを同じよ...
-
Excelで半角の文字を含むセルを...
-
エクセルの並び変えで、空白セ...
-
EXCELで 一桁の数値を二桁に
-
エクセルの表から正の数、負の...
-
Excel、市から登録している住所...
-
エクセルで文字が混じった数字...
-
A列がない・・・A列が非表示に...
-
エクセルの項目軸を左寄せにしたい
-
エクセルで一列おきに空白列を...
-
【ACCESS/必須条件とOR条件を組...
-
エクセルの隣り合う列のグループ化
-
エクセル(勝手に太字になる)
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセルで二つの数字の小さい...
-
PowerPointで表の1つの列だけ...
-
エクセルで最初のスペースまで...
-
2つのエクセルのデータを同じよ...
-
エクセル(勝手に太字になる)
-
「B列が日曜の場合」C列に/...
-
エクセル 文字数 多い順 並...
-
EXCELで 一桁の数値を二桁に
-
エクセル 同じ値を探して隣の...
-
VBAで文字列を数値に変換したい
-
エクセルの並び変えで、空白セ...
-
Excelで半角の文字を含むセルを...
-
エクセルで文字が混じった数字...
-
Excel、市から登録している住所...
-
A列がない・・・A列が非表示に...
-
エクセルの表から正の数、負の...
-
[関数得意な方]教えて下さい・...
-
エクセルの項目軸を左寄せにしたい
-
エクセル 時間帯の重複の有無
-
Excelにてある膨大なデータを管...
おすすめ情報