- ベストアンサー
複数行選択して移動するには、どうしたらよいですか？
複数行選択して移動するには、どうしたらよいですか？ たびたび、すみません。 E列に数値が並んでいて、その順位をF列に記述するようにしました。 これで、A,B,C,D列も一緒にG,H,I,J例に記入する方法を教えて頂けませんでしょうか？ 数値が記入されていてA→G、B→H、C→I、D→Jに値だけ移動させたいのですが、すみませんが宜しくお願いします。 Sub Macro1() Dim r As Range, a As Range Range("E1:E17").Select For Each r In Selection If r.Value <> "" Then r.Offset(, 1).Value = Application.WorksheetFunction.Rank(r, Selection, 1) End If Next r End Sub あと、Select しない書き方も研究してください。と指摘、頂いたのですがまだ未解決なので、そこはそのままになっております
- konekos
- お礼率80% (40/50)
- オフィス系ソフト
- 回答数1
- ありがとう数1
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
値だけ移動だと Range("G：J").Value=Range("A:D").Value Range("A:D").Clear になりますけど… ランクをA→G、B→H、C→I、D→Jに設定したいというのでしたら Range("E1:E17").Select のE列指示をそれぞれ各列に r.Offset(, 1).Value の数値をGの場合は6にしてくださいAからGまでの差6列という意味の数値
関連するQ&A
- 二つの条件式を一つにまとめようとしてます。
二つの条件式を一つにまとめようとしてます。 マクロを勉強しております。以前も質問させて頂いて、やりたい事は解決出来たのですが、更に別の事をしようと思いつまずきました。 A列の17行目まで数値が記入してあり、その順位をB列に記入するマクロを作りました。ここまでは何とか教えて頂いて出来たのですが。 さらに背景色が付いているセルを空欄にしてから順位を出そうとしました。それで、自分なりに記入して出来たのですが、この二つを一つにまとめようとしたらうまくいきません。Select case ～などを使用してみたのですが、よく分からなくなりました。どのようにしたらよいかだれか教えてください。 Sub Macro2() Dim r As Range Range("A1:A17").Select For Each r In Selection If r.Interior.ColorIndex <> xlNone Then r.Value = "" End If Next r End Sub Sub Macro1() Dim r As Range, a As Range Range("A1:A17").Select For Each r In Selection If r.Value <> "" Then r.Offset(, 1).Value = Application.WorksheetFunction.Rank(r, Selection, 1) End If Next r End Sub あと、Select しない書き方も研究してください。と指摘、頂いたのですがまだ未解決なので、そこはそのままになっております。
- ベストアンサー
- オフィス系ソフト
- 空白セルと０値を識別させたい。（VBA）
すみません、誰か教えていただけますか。 シートの53、54、55行目にそれぞれ値入っています。 それを３行目にビジュアル的に表現させています。 55行目はセルの色で、53行目は数値があり同じ値が 続く部分の合計を出しています。 しかし、下記の記述ですと数値が0（変数D=0）の時に うまくいきません。空白セルと認識されてしまうと思います。 何か、良い方法があれば教えて頂けませんでしょうか。 宜しくお願いします。 Sub 表示() Dim a As Long Dim c As Long Dim D As Long Dim e As String Dim f As String c = 3 For a = 3 To 64 With Worksheets("Sheet1") If .Cells(53, a) <> .Cells(53, a + 1) Then .Range(.Cells(53, c), .Cells(53, a)).Select D = WorksheetFunction.Sum(Selection) e = D f = Selection(1).Offset(1, 0).Value G = Selection(1).Offset(2, 0).Value If D <> 0 Then Selection(1).Offset(-50, 0).Value = f + "//" + e .Range(.Cells(53, c), .Cells(53, a)).Offset(-50, 0).Select Selection.Interior.ColorIndex = G End If If Selection(1).Value = "" Then .Range(.Cells(53, c), .Cells(53, a)).Offset(-50, 0).Select Selection.ClearContents Selection.Interior.ColorIndex = xlNone End If c = a + 1 End If End With Next End Sub
- ベストアンサー
- オフィス系ソフト
- E列が空白のとき、その空白行を削除し、番号を振り直す
windows7 Excel2003でマクロ勉強中です。 あるサイトにE列が空白のとき、その空白行を削除し、番号を振り直すという コードがありました。 自分で作った表（表の最上段の２行は項目名が入っています。）で 実行すると「Rangeメソッドは失敗しました。Globalオブジェクト」と エラーが出ます。エラーはでますが、処理自体は正しく実行されます。 このエラーの原因と回避するにはどうしたらよろしいでしょうか。 Sub E列が空白のとき、その空白行を削除し、番号を振り直す() Dim i As Long, j As Long '行削除の処理 For i = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1 If Range("A" & i).Value <> "" And IsNumeric(Range("A" & i).Value) = True Then If Range("E" & i).Value = "" Then Rows(i).Delete End If End If Next '番号振りなおし処理 '’’Range("A" & Rows.Count).End(xlUp).Offset(1).Select For i = 0 To Range("A" & Rows.Count).End(xlUp).Row If Range("A" & i).Value = "番号" Then j = 1 ・・・・・ここでエラー発生 If Range("A" & i).Value <> "" And IsNumeric(Range("A" & i).Value) = True Then Range("A" & i).Value = j j = j + 1 End If Next ActiveSheet.Protect End Sub
- ベストアンサー
- Visual Basic
- VBAで文字列を数値に変換したい
A列とE列の文字列になってしまった数値を 数値に変換したく、以下のようなものを作ったのですが、 文字の無いセルまで、数値に変換しようとするので 時間がかなりかかります。 何かよい方法は無いでしょうか？ よろしくお願いいたします。 Sub 数値に変換() Range("A:A,E:E").Select For Each xCell In Selection xCell.Value = xCell.Value Next xCell End Sub 使用ソフトEXCEL2000orEXCEL2003
- ベストアンサー
- オフィス系ソフト
- 検索後のセルの選択を正しくしたい
Excel2007でマクロ作成中の初心者です。 以下のコードの中で(1)のところがうまく作動できません。 ここの ActiveCell.Select を正常にするにはどうしたらよいかご教示をお願いします。 Sub 最終日の検索() Dim FC As Range Dim mydate As Date mydate = Range("BQ5").Value For Each FC In Range("BR30:BR300") If FC.Value = DateValue(mydate) Then Exit For End If Next If FC Is Nothing Then MsgBox "みつかりませんここでおわりです" Exit Sub End If MsgBox "見つかりました" & vbLf & FC.Address(0, 0) & vbLf & FC.Value ' ' ここに処理を追加したい ActiveCell.Select ’----------(1) Selection.Offset(0, 45).Select ActiveCell.Select 貼付けしてあるかどうか Set FC = Nothing End Sub ---------------------------------- Sub 貼付けしてあるかどうか() If ActiveCell.Value = "※※" Then MsgBox " 既に貼付けしてあります" Else MsgBox "貼付けしてないので処理します" End If End Sub
- ベストアンサー
- Visual Basic
- 特定範囲のセルの最終文字1文字を削除
よろしくお願いします。 Sheet1のJ26からJ56の、セルに入れた文字の最終文字1文字を 削除して表示したいのですが、下の構文で、 For Each r In Application.Selectionが黄色くエラー表示されます。 どこをどのように直せばよいのか解りません。 よろしくお願いします。 Private Sub CommandButton1_Click() Dim r As Range r = Worksheets("Sheet1").Range("J26:J56") For Each r In Application.Selection If Len(r.Value) > 0 Then r.Value = Left(r.Value, Len(r.Value) - 1) End If End Sub Next
- ベストアンサー
- Excel（エクセル）
- VBAでの行削除について
教えてください。 現在、VBAを使用して、CSVファイルの編集をしたいと考えています。 フォルダ内に数個のCSVファイルがあり、それらにすべて同じ処理（行削除など）をしたいのです。 下記のようなプログラムです。 Sub getting() Dim myPath As String Dim myFName As String Dim FCnt As Integer Dim A(500) As String MsgBox CurDir() Workbooks("自動処理.xls").Activate myPath = ActiveWorkbook.Path MsgBox myPath ChDir myPath FCut = 0 myFName = Dir("*.csv") If myFName <> "" Then FCut = FCut + 1 A(FCut) = myFName Do myFName = Dir() If myFName <> "" Then FCut = FCut + 1 A(FCut) = myFName MsgBox A(FCut) Else Exit Do End If Loop End If MsgBox "「" & myPath & "」には、" & FCut & "個のファイルがあります。" Dim i As Integer Dim seet As String Dim ws As Object Dim FullPath As String For i = 1 To 1 seet = Left(A(1), 6) FullPath = myPath & "\" & A(i) 'Workbooks.Open(FullPath).Activate Open FullPath For Append As #1 Print #1, Rows("1:1").Select Selection.Delete Shift:=xlUp Rows("2:2").Select Selection.Delete Shift:=xlUp Range("A1").Select Print #1, Range("A1").Value = "" Print #1, Range("A1").Value = "COMP_NAME" Print #1, Range("B1").Select Print #1, ActiveCell.Value; "PC_OS" Print #1, Range("C1").Select Print #1, ActiveCell.Value = "OS_SUB_VERS" Print #1, Range("D1").Select Print #1, ActiveCell.Value = "IP_ADDR" Print #1, Range("E1").Select Print #1, ActiveCell.Value = "LOCATION " Close #1 ' Workbooks(A(i)).Save ' Workbooks(A(i)).Close savechanges:=False Next i End Sub 教えていただきたいのは、どうにかworkbook.openを使わず、ファイルを編集できるところまでいったのですが、ファイルを開かずに行を削除することができません。 ＞Print #1, Rows("1:1").Select ＞Selection.Delete Shift:=xlUp ＞Rows("2:2").Select ＞Selection.Delete Shift:=xlUp ファイルを開かずに行削除をできるものなのでしょうか。 ご存知の方がいれば教えてください。 よろしくお願いいたします。
- 締切済み
- その他（プログラミング・開発）
- エクセルＶＢＡについて
http://okwave.jp/qa/q7236213.html 上記質問の発展形なのですが 同様のことを Ｅ列に日付 Ｆ列に売上 Ｇ列に結果 でやりたいのですが この時Ａ列～Ｃ列のマクロも残したままでしたいのですが 下記のように同様のプロシージャーを下段に書けばできると思ったのですが うまくいきません。 Private Sub worksheet_change(ByVal Target As Excel.Range) If Target.Address <> "$A$1" Then Exit Sub If Target = "" Then Exit Sub Range("C10:C65536").ClearContents With Range(Cells(9 + Range("A1").Value, "C"), Cells(Range("A65536").End(xlUp).Row, "C")) .FormulaR1C1 = "=MAX(RC2:R[" & -Range("A1").Value + 1 & "]C2,FALSE)" .Value = .Value End With End Sub Private Sub worksheet_change(ByVal Target As Excel.Range) If Target.Address <> "$E$1" Then Exit Sub If Target = "" Then Exit Sub Range("G10:G65536").ClearContents With Range(Cells(9 + Range("E1").Value, "G"), Cells(Range("E65536").End(xlUp).Row, "G")) .FormulaR1C1 = "=MAX(RC6:R[" & -Range("A1").Value + 1 & "]C6,FALSE)" .Value = .Value End With End Sub どなたかお知恵を拝借できませんでしょうか？
- ベストアンサー
- オフィス系ソフト
- エクセルのマクロで打ち込んだ数字のより分けをしたいと思い下記のコードで
エクセルのマクロで打ち込んだ数字のより分けをしたいと思い下記のコードで実行してみたのですが、空白セルを選択したところで砂時計のままになりフリーズしてしまいます。どこが間違っているのでしょうか？ ちなみに手動で空白選択部分を右クリック→削除（上方）としてもやはり固まってしまいます。やりたいのはA列にランダムに打ち込んだ数字の５千番台、９千番台をB列、C列に移して空白セルを埋めると言うものです。手動でもだめと言うことは何か別の理由も考えられますでしょうか？使用PCはWIN－XPです。 Sub Sorting1() Dim R As Long For R = 1 To Cells(Rows.Count, "A").End(xlUp).Row If Cells(R, "A").Value >= 5000 And Cells(R, "A").Value <= 5999 Then Cells(R, "B").Value = Cells(R, "A").Value Cells(R, "A").Value = "" End If If Cells(R, "A").Value >= 9000 And Cells(R, "A").Value <= 9999 Then Cells(R, "C").Value = Cells(R, "A").Value Cells(R, "A").Value = "" End If Next R On Error Resume Next Range("A1:C10000").Select Selection.SpecialCells(xlCellTypeBlanks).Select Selection.Delete Shift:=xlUp Range("A1").Select End Sub
- ベストアンサー
- Visual Basic
- VBA シート間の同期（列、行、選択範囲）
初めての質問となります。 よろしくお願いいたします。 シート間の同期でセルの同期は他の質問を参照してできましたが、 ”行”や”列”での同期/相互参照は、どのように書けばいいのでしょうか。。 下記、sheet1”A1”とsheet2の”B1”に記載したcodeです。 'sheet1に以下を記述 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$A$1" Then Sheets("Sheet2").Range("$B$1").Value = Sheets("Sheet1").Range("$A$1").Value End If End Sub 'sheet2に以下を記述 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$B$1" Then Sheets("Sheet1").Range("$A$1").Value = Sheets("Sheet2").Range("$B$1").Value End If End Sub 【質問内容】 sheet1の”A列”とsheet2の”B列”はどう書くのでしょう？ 上記の方法では無理、または負荷が大きい場合は、 sheet1の”A1:C3”とsheet2の”D4:F6”はどう書くのでしょう？ という内容になります。 先日からVBAを触り始め、 自分なりに調べて一通り試してみましたが解決できませんでした。。 お手数おかけしますが何卒よろしくお願いいたします。
- ベストアンサー
- その他MS Office製品
お礼
kmetu様 有難うございます。各列それぞれ指示で出来ました。