以下のコードで「入力」シートのデータから「DB]シートに登録するんです。「DB」シートの一行目A1は題名ですが新しいデータに入ってくるとどんどん題名は下の行に下がっていく。
題名は固定し、新しいデータはA2から入ってくるようにしたいですがどこに変更すればいいかわからなくて困っています。(ExcelのVBAはまったくわかりません)
よろしくお願いします。
Excel 2007
Sub 登録_Click()
'On Error GoTo Err_登録
Dim n As Integer '入力明細の数
Dim x As Long 'DBの検索範囲の最終行
Dim rng As Range '検索したセル
Dim z As Long 'DBのデータの最終行
Dim tbl As Worksheet '[DB]シート
Dim key As String '検索キー
Dim from_key As Long '更新範囲(自)
Dim to_key As Long '更新範囲(至)
'警告メッセージ非表示
Application.ScreenUpdating = False
Worksheets("入力").Activate
Set tbl = Sheets("DB")
z = tbl.Range("A1").CurrentRegion.Rows.Count
Check_登録:
key = Range("B2").Value
If key = "" Then
MsgBox "発注番号が未入力です。"
Exit Sub
End If
'[発注番号]でソート
tbl.Range("A1").Sort Key1:=tbl.Range("A1"), Header:=xlGuess
'存在チェック
x = tbl.Range("A1").End(xlDown).Row
With tbl.Range("A1:A" & x)
Set rng = .Find(key, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows)
If Not rng Is Nothing Then
MsgBox "既存の番号が存在します。"
Exit Sub
End If
End With
'明細行有無チェック
n = WorksheetFunction.CountIf(Range("M46:M65"), "*")
If n = 0 Then
MsgBox "明細行がありません。"
Exit Sub
End If
Add_登録:
'空白行を省く
Selection.AutoFilter Field:=14, Criteria1:="<>"
'コピー&貼り付け
Range("A47:U66").Copy
tbl.Range("A" & z + 1).PasteSpecial Paste:=xlPasteValues
'[発注番号]でソート
tbl.Range("A1").Sort Key1:=tbl.Range("A1"), Header:=xlGuess
'コピーモード解除
Application.CutCopyMode = False
'空白行を省くを解除
Selection.AutoFilter Field:=14
'ブック保存
'ActiveWorkbook.Save
'画面クリア
Call 画面クリア
'警告メッセージ表示
Application.ScreenUpdating = True
Exit_登録:
MsgBox "登録しました。"
Exit Sub
Err_登録:
MsgBox "エラーが発生しました
No.3ベストアンサー
- 回答日時:
>>ANo.2
きっと他人が作ったプログラムの修正。貼るしかない気が…
ソースは確かに美しくないけどね;;
>>ANo.1
あれ、ANo.1じゃダメでした?それとも説明が悪かったかな。。
ダメでしたら、シートの構造と使い方の補足をお願いします。
◆ANo.1まとめ
VBA 24行目と51行目の2箇所を変更してみてください。
(修正前)1行目がタイトルか自動判別
tbl.Range("A1").Sort Key1:=tbl.Range("A1"), Header:=xlGuess
(修正後)1行目をタイトルとする
tbl.Range("A1").Sort Key1:=tbl.Range("A1"), Header:=xlYes
◆+α
質問とは別件ですが…
> '明細行有無チェック
> n = WorksheetFunction.CountIf(Range("M46:M65"), "*")
M46~M65のセルが、全部空ならエラーにする処理です。
多分、M47~M66の間違いかと。そうなら、"M47:66"に修正シテネ!
No.2
- 回答日時:
こういう質問は、原データが無いので、チェックがしにくい。
どうせ丸投げするなら、文章でやりたいことを書いて質問してくれたほうが(丸投げだが)まだまし。
手本にした(あるいは質問者が弄り回したのかもしれないが)コードは、癖があって、どこかで見習った方法を、総動員した感じで、初心者向けには、勉強に適当ではないと思うし無駄があるように思う。。
(1)研作(未入力チェック
2)ソートーーA列に入っている、発注番号でらしい
(3)存在チェックーーA列で。存在チェックはFindでやってなぜ後半はCountIF関数なのかな?
存在チェックにその前のソートは効いているのかな(ソートする必要はあるのかな)
存在チェックそのものも不要に見えるが。
(4)空白行は除く
(5)DBシートへの貼り付け
と処理が複雑だが
ーーー
エクセルもVBAも判らないというなら、
For Nextで最初の行から最終行まで(1行ずつ)
IFステートメントでその行の内容を判別する。そして
その行が条件に合わない行は処理せず(次の行の処理に移り)、
条件に合ったものは、DBシートに1行分の列項目を代入(代入先行を1行ずつ、づらすテクニック要)
必要あれば最後にDBシートで並べ替え
の方法が、素直な考え方で、初心者むけだ。
No.1
- 回答日時:
#ぱっと見ただけなので、間違ってたらゴメンネですが…
> 'コピー&貼り付け
> Range("A47:U66").Copy
> tbl.Range("A" & z + 1).PasteSpecial Paste:=xlPasteValues
>
> '[発注番号]でソート
> tbl.Range("A1").Sort Key1:=tbl.Range("A1"), Header:=xlGuess
「入力」のA47:U66を、「DB」の一番 "下" に貼り付けてから、「DB」をA列でソートしてます。
たぶん、ここでタイトル行がデータ扱いされちゃってるんじゃないかな?
(修正)
> tbl.Range("A1").Sort Key1:=tbl.Range("A1"), Header:=xlYes
"Header:=xlGuess" 「タイトル行の有無を自動判別」 から、
"Header:=xlYes" 「先頭行をタイトルと見なす」 に・・・
ソート処理が2箇所あるので、両方とも変更してみてください。
ただ、コレが原因だとしたら、「自動判別できなくなった」のが問題な気がします。
プログラム作成当初とは何かが変わっているんじゃないでしょうか?
VBAを直すより、A列を見直してみる方がいいかもです。
ご回答ありがとうございます。
修正したやはり自動判別ができなくなって、入力したデータが混乱してしまいました。
そして、私の言い方が間違いました。A列はタイトルではなく1列はタイトルです。
エクセルは得意ではないですので、どこをどのように見直したらいいかわかならないです。
これは原因かもしれないという点があれば、是非教えて頂きたいです。
よろしくお願いします。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・街中で見かけて「グッときた人」の思い出
- ・「一気に最後まで読んだ」本、教えて下さい!
- ・幼稚園時代「何組」でしたか?
- ・激凹みから立ち直る方法
- ・1つだけ過去を変えられるとしたら?
- ・【あるあるbot連動企画】あるあるbotに投稿したけど採用されなかったあるある募集
- ・【あるあるbot連動企画】フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?
- ・映画のエンドロール観る派?観ない派?
- ・海外旅行から帰ってきたら、まず何を食べる?
- ・誕生日にもらった意外なもの
- ・天使と悪魔選手権
- ・ちょっと先の未来クイズ第2問
- ・【大喜利】【投稿~9/7】 ロボットの住む世界で流行ってる罰ゲームとは?
- ・推しミネラルウォーターはありますか?
- ・都道府県穴埋めゲーム
- ・この人頭いいなと思ったエピソード
- ・準・究極の選択
- ・ゆるやかでぃべーと タイムマシンを破壊すべきか。
- ・歩いた自慢大会
- ・許せない心理テスト
- ・字面がカッコいい英単語
- ・これ何て呼びますか Part2
- ・人生で一番思い出に残ってる靴
- ・ゆるやかでぃべーと すべての高校生はアルバイトをするべきだ。
- ・初めて自分の家と他人の家が違う、と意識した時
- ・単二電池
- ・チョコミントアイス
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
マクロの「SaveAs」でエラーが...
-
テキストボックスから、複数の...
-
マクロ実行後に別シートの残像...
-
VBA 空白行に転記する
-
VBA別シートの最終行の次行へ転...
-
100万件越えCSVから条件を満た...
-
VBA 実行時エラー1004 rangeメ...
-
EXCELのSheet番号って変更でき...
-
Changeイベントで複数セルへの...
-
グラフマクロで系列を変数にす...
-
Excel VBA オートフィルターで...
-
VBA 別ブックからの転記の高速...
-
楽天RSSからエクセルVBAを使用...
-
ExcelのVBマクロを、バックグラ...
-
VBAでEXCELから固定長...
-
Unionでの他のシートの参照につ...
-
VBAで変数の数/変数名を動的に...
-
複数シートの複数列に入力され...
-
アクセスからエクセルへ出力時...
-
VBA シート間の転記で、条件の...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
マクロの「SaveAs」でエラーが...
-
EXCELのSheet番号って変更でき...
-
VBA 空白行に転記する
-
マクロ実行後に別シートの残像...
-
VBAで変数の数/変数名を動的に...
-
VBA別シートの最終行の次行へ転...
-
Changeイベントで複数セルへの...
-
アクセスからエクセルへ出力時...
-
VBA 別ブックからの転記の高速...
-
Count Ifのセルの範囲指定に変...
-
【VBA】特定の条件でセルをコピー
-
VBA 実行時エラー1004 rangeメ...
-
ExcelのVBマクロを、バックグラ...
-
100万件越えCSVから条件を満た...
-
複数シートの複数列に入力され...
-
楽天RSSからエクセルVBAを使用...
-
Excel2013で切り取り禁止
-
Excel VBA オートフィルターで...
-
Unionでの他のシートの参照につ...
-
VBAを使って複数のシートから抽...
おすすめ情報