• ベストアンサー

どなたかマクロ修正お願いします。

g_nekoruの回答

  • g_nekoru
  • ベストアンサー率34% (30/88)
回答No.6

#2です。 1.結果としてどういう処理にしたいのでしょうか? 2.Sheet1の元データを変換したいのでしょうか? それともsheet3の=1!A100の式を変換後の文字列で上書きしていいのでしょうか? 3.=1!A100の式はそのまま生かし表示だけを"中田英寿"にしたいのでしょうか? 2の場合は関数と文字が混在した列になってしまうのですが、今後内容が変わらず関数にしておく必要がないのであれば名前の列全体を実際の文字列に置き換えてはどうでしょうか? 3の場合は単なる応急処理になり後々を考えると面倒になりそうです。

関連するQ&A

  • マクロ修正お願いします。

    以前質問してマクロを作成してもらった者です。 人事データ用に作っていただきました。 Sheet1   A   B   C 1 処遇 コード 名前.... 2 退社  3   あ   3 異動  4   か   4 入社  20   さ  Sheet2   A   B    C 1 コード 名前  データ1... 2  3   あ    3  4   か    4   Sub testsample() Dim Sh1 As Worksheet, Sh2 As Worksheet Dim r As Range, c As Range Set Sh1 = Worksheets("Sheet1") Set Sh2 = Worksheets("Sheet2") For Each c In Sh1.Range("A2", Sh1.Range("A65536").End(xlUp)) Select Case c.Value Case "入社"  c.Offset(, 1).Resize(, 255).Copy Sh2.Range("A2").End(xlDown).Offset(1)  'B列より、右端255行を、シート2のA列の最後尾の次にコピーする。 Case "異動"  Set r = Sh2.Columns(1).Find(c.Offset(, 1).Value, , xlValues, xlWhole)  If Not r Is Nothing Then c.Offset(, 1).Resize(, 255).Copy r  'コードを検索して、その見つかったものを上書き Case "退社"  Set r = Sh2.Columns(1).Find(c.Offset(, 1).Value, , xlValues, xlWhole)  If Not r Is Nothing Then r.EntireRow.Delete  'コードを検索して、その見つかったものを削除 End Select Next End Sub このマクロで一箇所どーしたらいいか分からない場所があります。 「異動」があった場合、sheet1には氏名コードと新しく配属される部署やtelなどのみを書き、メールアドや氏名など異動しても変わらないものは書き込みません。変更があった箇所のみ上書きし空白部分はそのままにしたいです。何度もすみませんがお願いします。

  • シートをオブジェクト変数に格納しつつ、findで文

    前回、http://okwave.jp/qa/q7965940.html で質問したのですが、 シートをオブジェクト変数に格納しつつ、findで文字を検索する場合、どうすればいいでしょうか? Sub test() Dim sh1 As Worksheet Dim 行 As Long Set sh1 = Sheets("Sheet1") 行 = Cells.Find(What:="検索文字", LookAt:=xlWhole).Row End Sub こういう事を行いたいのですが、 Sheet2がアクティブな時にこのコードを実行すると実行時エラー91になります。 対処方法をお願いいたします。

  • EXCEL マクロの指定の仕方

    マクロで線の色を指定したいのですが、上手くいかず困っています .ForeColor.RGB = Worksheets("sheet1").Range("F2").Interior.ColorIndex 赤色を指定したいのですがBにどういうコードを入れれば良いですか? FはVlookupで列Bより色を指定するようにしています。 マクロは始めたばかりで良く分からないので、他に必要な情報もわかりません 必要な情報なども併せて教えてください。 よろしくお願いします。 Dim rngStart As Range Dim rngEnd As Range Dim BX As Single, BY As Single, EX As Single, EY As Single Set rngStart = Worksheets("sheet2").Cells.Find(What:=Worksheets("sheet1").Range("D2"), LookIn:=xlValues, LookAt:=xlWhole) Set rngEnd = Worksheets("sheet2").Cells.Find(What:=Worksheets("sheet1").Range("E2"), LookIn:=xlValues, LookAt:=xlWhole) BX = rngStart.Left BY = rngStart.Top EX = rngEnd.Left + rngEnd.Width EY = rngEnd.Top With Worksheets("sheet2").Shapes.AddLine(BX, BY + 10, EX, EY + 10).line .ForeColor.RGB = Worksheets("sheet1").Range("F2").Interior.ColorIndex .Weight = 3 .EndArrowheadStyle = msoArrowheadTriangle End With

  • このマクロを少し修正したい

    先日、こちらのサイトで下記のマクロを作っていただきました。 エクセルの置換えシートを使って、別のエクセルシートを一括置換えするマクロです。 ただ、置換えしたいシートのセルが結合していたり、文字の前に空欄が入っていると変換されません。 上記も認識しての置換えは、下記のマクロを修正して可能でしょうか? 修正したマクロを教えていただけると助かります。  With ThisWorkbook   If ActiveSheet Is .Worksheets(1) Then Exit Sub   For i = 1 To .Worksheets(1).Range("A65536").End(xlUp).Row    ActiveSheet.Cells.Replace _      What:=.Worksheets(1).Range("A" & i).Value, _      Replacement:=.Worksheets(1).Range("B" & i).Value, _      LookAt:=xlPart, SearchOrder:=xlByColumns   Next  End With End Sub

  • マクロを組むとこんなエラーが出るようになりました

    捺印君:Vel 1.25→(エクセルのフリーソフトです) PicturesクラスのPasteプロパティを取得出来ません。 予期せぬエラーが発生しました。 とエラーが出ます。 ちなみに組んでいるマクロは下記です Sub 全シートの保護() Dim Sh As Worksheet Dim myPassword As String myPassword = InputBox("パスワードを入力してください", "パスワード") For Each Sh In Worksheets Sh.Protect Password:=myPassword Next End Sub Sub 全シートの解除() Dim Sh As Worksheet Dim myPassword As String myPassword = InputBox("パスワードを入力してください", "パスワード") For Each Sh In Worksheets Sh.Unprotect Password:=myPassword Next End Sub このマクロがおかしいからエラーが出るんですよね? 違うマクロにすれば問題ないでしょうか? ちなみにマクロは「全シートの保護一括解除」と「一括保護」で パスワード付きの物をとなっております。

  • マクロで複数のシートを保護&パスワードをかける為に下記式を作成しました

    マクロで複数のシートを保護&パスワードをかける為に下記式を作成しましたが エラー”400”のみ出て上手く行きませんでした。 どこか式がおかしいのでしょうか。。。 一応式を入力しておきます。 超初心者でまったく意味がわからないので、どなたか宜しくお願い致しますm(__)m Sub AllProtect() Dim sh As Worksheet Dim myPassword As String myPassword = InputBox("パスワードを入力してください", "パスワード") For Each sh In Worksheets sh.Protect Password:=1234 Next End Sub Sub AllUnprotect() Dim sh As Worksheet Dim myPassword As String myPassword = InputBox("パスワードを入力してください", "パスワード") For Each sh In Worksheets sh.Unprotect Password:=1234 Next End Sub

  • VBAで修正ボタンを作成

    先ほどは登録ボタンを作成したのでが、 修正ボタンもあれば便利だと思い作りたいのですが 一向にできません。 一覧表より、番号を検索して一致するセルの場所に 上書き?保存をするようにしたいのですが どのようにすればよいでしょうか? 先ほどから新たに訂正を加えたのですが、 やはりダメでした。 Private Sub CommandButton2_Click() '修正ボタン Dim bk As Workbook Dim sh1 As Worksheet Dim sh2 As Worksheet Dim cnt1 As Long Set bk = ThisWorkbook Set sh1 = bk.Worksheets("現場登録検索") Set sh2 = bk.Worksheets("一覧") cnt1 = 6 'マッチ Range("F2").Select n = ActiveCell.FormulaR1C1 = "=MATCH(RC[-1],一覧!C[-5],0)" cnt1 = n '送り方 sh2.Cells(n, 22).Value = sh1.Cells(4, 3).Value '封筒 sh2.Cells(n, 23).Value = sh1.Cells(5, 3).Value MsgBox "修正できました。" End Sub よろしくお願い致します。

  • LookAt の定数を変数で指定するには?

    エクセルvbaです。 Sub test() Dim strLookAt As String strLookAt = "xlPart" Cells.Replace What:="aaa", Replacement:="iii", LookAt:=strLookAt End Sub このようなことはできないのでしょうか? LookAtの部分のxlWhole または xlPart かをシートから読み取って変数に格納し、 Replace メソッドで置換したいのですが、 このコードを実行すると「型が一致しません」になります。 多分、LookAt:=strLookAtでエラーになってるのだと思います。 String型だからいけないのでしょうか? 回避方法を教えてください。よろしくお願いします。

  • 異なるBookからの検索

    VBA初心者です。 集計.exl 野菜.exl 果物.exlとファイルがあり、野菜と果物にはシートが3枚づつあります。 集計ファイルのセルを野菜と果物ファイルから検索したいのです。 本等を見て調べたのですが、異なるBookからの検索方法が見つかりません。 Private Sub kensaku() Dim i As Integer Dim myFLd As Range, myRng As Range ' i = Cells("3,2").Select Workbooks.Open ("C:\果物.xls") Worksheets.Select Set myRng = myFLd.Find(what:=i, lookat:=xlWhole) If myRng Is Nothing Then Workbooks.Open ("野菜.xls") Worksheets.Select Set myRng = myFLd.Find(what:=i, lookat:=xlWhole) Exit Sub End If If myRng Is Nothing Then MsgBox "ありません" Exit Sub End If MsgBox "対象" & myRng.Address End Sub としたのですが、 Set myRng = myFLd.Find(what:=i, lookat:=xlWhole) 部分のエラー(whitがありません)とでて、直りません。 あと、このやり方であっているのでしょうか? アドバイスお願いします。

  • エクセルVBA selectionの書き方をヘルプ!

    ここで教えてもらったVBAを書き直して以下のように作りました。 Sub TEST() Dim sh1 As Worksheet Dim sh2 As Worksheet Set sh1 = Worksheets("Sheet1") Set sh2 = Worksheets("Sheet2") d = 5 For i = 1 To d Set x = sh2.Range("E7:F11").Find(What:=sh1.Cells(i, "C"), After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) If Not x Is Nothing Then sh1.Cells(i, "D") = x.Offset(0, 1) Next i End Sub ところが「RangeクラスのFindプロパティが取得できません」とエラーになってしまいます。Range("E7:F11")をCellsにすればエラーにはならないのですが、検索範囲を指定したいのです。 sh2.Select Range("E7:F11").Select を入れ、Range("E7:F11")をSelectionにすれば動くのもわかりました。でもSelectせずにやりたいのです。 わがまま言いますが、お教えくださいませ。 お願いします。