アプリ版:「スタンプのみでお礼する」機能のリリースについて

 Excel2002です。入力シートと一覧シートを作成し、入力シートの入力フォームに入力すると一覧シートの表の最終行に新規で転記されるようにしました。
 また、入力シートでカタカナ検索すると、入力フォームに表示され、そのデータがある行番号をA1セルに取得するまではできました。検索表示したデータを修正し、取得した行番号に上書きしたいのですが、どうしても2行下に上書きされてしまいます。
 取得行番号 980  → 上書きされる行番号 982
そのまま980行にデータを上書きしたい場合、どうしたらいいのでしょうか?
 困っています。よろしくお願い致します。
--------------------------------------------------------------
Sub 新規レコード転記2()
Dim motoSht As Worksheet, sakiSht As Worksheet, sakiTbl As Range, sakiRng As Range, i As Long
Dim lastRec As Range, newRec As Range
Dim motoHani()

Application.ScreenUpdating = False '画面の更新をストップ


Set sakiSht = Sheets("一覧")

motoHani = Array("D4", "C6", "I6", "C7", "J7", "C8", "C9", "C10", "H10", "C11", "I11", "C12", "E12", "H12", "J12", "C14", "C13", "E13", "H13", "J13", "C15", "C16")

Set sakiRng = sakiSht.Range("B" & Rows.Count).End(xlUp).Offset(1)

For i = 0 To UBound(motoHani)
sakiRng.Offset(0, i).Value = motoSht.Range(motoHani(i)).Value
motoSht.Range(motoHani(i)).MergeArea.ClearContents
Next


MsgBox "入力を完了しました。"
End Sub

Sub 情報検索()
Dim tmpInt As String, motoHani(), myRng As Range, i As Integer
'変数の宣言
tmpInt = Sheets("入力").Range("D4").Value
'検索する文字列を取得
motoHani = Array("C6", "I6", "C7", "J7", "C8", "C9", "C10", "H10", "C11", "I11", "C12", "E12", "H12", "J12", "C14", "C13", "E13", "H13", "J13", "C15", "C16")
'転記する位置を設定

Set myRng = Range("顧客情報").Columns(1).Find(tmpInt, LookAt:=xlWhole)
'顧客情報の1フィールド目を対象に検索

If myRng Is Nothing Then
MsgBox "該当するレコードはありませんでした"
Exit Sub
End If
'検索値が無かった場合は処理を抜ける
For i = 0 To UBound(motoHani)
Range(motoHani(i)).Value = myRng.Offset(0, i + 1)
Next
'検索値が見つかったセルを元にレコードの情報を転記

'検索した行番号をA1セルに保存
Range("A1") = myRng.Row



End Sub

Sub 修正して上書き()
Dim no As Long, motoHani(), i As Integer

no = Range("A1")
motoHani = Array("D4", "C6", "I6", "C7", "J7", "C8", "C9", "C10", "H10", "C11", "I11", "C12", "E12", "H12", "J12", "C14", "C13", "E13", "H13", "J13", "C15", "C16")
For i = 0 To UBound(motoHani)
Range("顧客情報").Cells(no, i + 1) = Range(motoHani(i)).Value

Next

MsgBox "修正しました。"


End Sub
---------------------------------------------------------------

A 回答 (2件)

遅くなったので、もう解決済みかな?



Sub 修正して上書き()
Dim no As Long, motoHani(), i As Integer
no = Range("A1")-2  'ここで-2とするか
  ・
  ・
For i = 0 To UBound(motoHani)
'↓ここで-2にするか .Cells(no-2, i + 1)
Range("顧客情報").Cells(no, i + 1) = Range(motoHani(i)).Value
Next
MsgBox "修正しました。"
End Sub

ではダメですか
    • good
    • 0
この回答へのお礼

Range("顧客情報").Cells(no - 2, i + 1) = Range(motoHani(i)).Value で出来ました!
ありがとうございました。

自分でも-2は同じように入れてみたのですが、エラーになってしまったので諦めていました。何かが違ったのかも・・・

本当に助かりました。

お礼日時:2009/01/27 10:51

Sub 修正して上書き()


Dim no As Long, motoHani(), i As Integer
no = Range("A1")
motoHani = Array("D4", "C6", "I6", "C7", "J7", "C8", "C9", "C10", "H10", "C11", "I11", "C12", "E12", "H12", "J12", "C14", "C13", "E13", "H13", "J13", "C15", "C16")
For i = 0 To UBound(motoHani)
'Range("顧客情報").Cells(no, i + 1) = Range(motoHani(i)).Value     '元のコード
Cells(no, i + 1) = Range(motoHani(i)).Value    '修正後のコード
Next
MsgBox "修正しました。"
End Sub


ここまで作れるのであれば、コードの修正個所を見れば解るかな、と思いますが
解説が必要ですか?

この回答への補足

早速回答いだいてありがとうございます。VBAは本や資料を見ながら勉強し、何とかここまでたどり着いた感じなのです。
 質問内容に言葉が足りませんでした。
実は、「入力」というシートの入力フォームで検索。別の「一覧」というシートのセル範囲に"顧客情報"という名前を付けています。
Sub セル範囲に名前を付ける()
Dim myName As String, myRng As Range
myName = "顧客情報"
Set myRng = Worksheets("一覧").Range("B3:W65536")
ThisWorkbook.Names.Add myName, myRng

End Sub

「入力」シートのA1に検索結果の「一覧」シートの行番号を取得して、「一覧」シート顧客情報に上書きをしたいのです。

たぶん、"顧客情報"はB3から最終行まで指定しているので、行番号を取得し、上書きした際に2こずれてしまうと思います。(さっき気が付きました。)
ただ、上記のRange("B3:W65536")を(B1:W65536)にすると他に不具合が出てしまいます。
もう、考えがまとまらず戸惑っています。どうか教えてください。

補足日時:2009/01/20 09:27
    • good
    • 0

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

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