- ベストアンサー
エクセルの表に数字を入力するときに行と列に色をつける!!
エクセルで大きな表を作成した時に、表に数字を入れる場合、行と列を間違えて入力してしまうことがあります。それを防止するためにあるマクロが動いているあいだは、マウスがオーバーする行、列のセルに色を付けるようなマクロを作ろうかと考えました。(セルなどをクリックしなくても、マウスが移動すれば、マウスがかかっているセルの行と列に色がついてまわる)単純に、MauseMoveイベントで処理って思いつきましたが、対象がグラフにしかありません。で、途方にくれました。また、仮に、イベントの処理方法が判ったとしても、単純にセルに色をつけたり消したりしたのでは、元々表に色が付いていた場合、消して回ることになります。なにか?どのようにすれば実現が可能でしょうか?イメージ的には、CADなどでX軸とY軸に垂線と水平線がカーソルについて回るって感じです。 最大の問題は、カーソルが通り過ぎた時に元々の色に戻すっててんだと思いますが、どなたか?詳しい方がイラッシャイましたら教えて頂けないでしょうか? 宜しくお願い致します。
- vba_minarai
- お礼率28% (68/237)
- オフィス系ソフト
- 回答数5
- ありがとう数1
- みんなの回答 (5)
- 専門家の回答
質問者が選んだベストアンサー
こんにちは。KenKen_SP です。 > #案外実用的かも^ ^ すみません。やっぱり、#3 はうまくいかないみたいです。Excel で CallBack プロシージャを使うとコードに一見問題がないように見えても、何故か数秒後 にフリーズしたりして非常に苦労するのですが、今回は結構動いてたので、 調子にのって投稿してしまいました。しかし、しばらくほっとくと、フリーズ こそしないのですが、CallBack されなくなって動かなくなります。これでは 使い物にならないですね... いろいろ調整してみましたが、(私のスキルでは)実用不可でした。 少し真面目に実用に耐え得るコードを書いてみました。こっちの方がご質問の ご希望に近いかもしれません。 #3 と同じように、ユーザーフォームにトグルを一つ貼り付けて、コードをコピペ して下さい。今度はフォームモジュールのみで完結させてます。 このフォームを vbModeless で呼び出すか、VBE のフォームの ShowModal プロパ ティーの値を False にしておきます。 ' ソースコード(フォームモジュール)------------------------------------ Option Explicit Private mLineHT As Shape, mLineHB As Shape Private mLineVL As Shape, mLineVR As Shape Private Const BASENAME As String = "$CurLine_$" Private Const MARJIN As Single = 500 Private Const LINE_WEIGHT As Single = 1.5 ’線の太さをPtで設定 Private WithEvents xlApp As Application Private mSh As Worksheet Private Sub UserForm_Initialize() ' 初期化 With Me .StartUpPosition = 0 ' Manual .Width = 80: .Height = 40 .Caption = "Line Cursol" ' 初期表示位置(適当に修正して下さい) .Top = ActiveWindow.Top + 120 .Left = ActiveWindow.Width - .Width - 40 End With With Me.ToggleButton1 .Top = 0: .Left = 0 .Width = Me.InsideWidth: .Height = Me.InsideHeight .Caption = "On" End With Set xlApp = Application Set mSh = ActiveSheet Exit Sub ERROR_HANDLER: MsgBox Err.Description, vbExclamation Unload Me End Sub Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) Call Lines_Del(True) Set mSh = Nothing Set xlApp = Nothing End Sub Private Sub ToggleButton1_Change() Dim i As Long With Me.ToggleButton1 If .Value Then .Caption = "On" Call Lines_Add Else .Caption = "Off" Call Lines_Del End If End With End Sub Private Sub Lines_Add() On Error Resume Next Application.ScreenUpdating = False If Not mSh Is ActiveSheet Then Call Lines_Del Set mSh = ActiveSheet End If Call Lines_Del With ActiveCell.MergeArea Set mLineHT = sp_DrawLine(.Top) Set mLineVL = sp_DrawLine(, .Left) Set mLineHB = sp_DrawLine(.Top + .Height) Set mLineVR = sp_DrawLine(, .Left + .Width) End With End Sub Private Sub Lines_Del(Optional ByVal ALL_LINES As Boolean) Dim Wb As Workbook Dim Sh As Worksheet Dim shpLine As Shape If Not ALL_LINES Then On Error GoTo ALL_LINES_DELETE mLineHT.Delete: mLineHB.Delete mLineVL.Delete: mLineVR.Delete Else ALL_LINES_DELETE: On Error Resume Next For Each Wb In Workbooks For Each Sh In Wb.Worksheets For Each shpLine In Sh.Shapes If shpLine.Name Like BASENAME & "*" Then shpLine.Delete End If Next shpLine Next Sh Next Wb End If Set mLineHT = Nothing: Set mLineHB = Nothing Set mLineVL = Nothing: Set mLineVR = Nothing On Error GoTo 0 End Sub Private Function sp_DrawLine( _ Optional ByVal sglT As Single, _ Optional ByVal sglL As Single) As Shape Dim sglW As Single Dim sglH As Single sglW = Columns(Columns.Count).Left + MARJIN sglH = Rows(Rows.Count).Top + MARJIN If sglL = 0 And sglT >= 0 Then Set sp_DrawLine = ActiveSheet.Shapes.AddLine(0#, sglT, sglW, sglT) ElseIf sglT = 0 And sglL >= 0 Then Set sp_DrawLine = ActiveSheet.Shapes.AddLine(sglL, 0#, sglL, sglH) Else Err.Raise 1000, , "sp_DrawLine 関数に不正パラメータが渡されました." End If With sp_DrawLine .Name = BASENAME & .Name .Line.Weight = LINE_WEIGHT .Line.Style = msoLineSingle .Line.ForeColor.SchemeColor = 48 End With End Function Private Sub xlApp_SheetActivate(ByVal Sh As Object) If Me.ToggleButton1.Value Then Call Lines_Add End If End Sub Private Sub xlApp_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) If Me.ToggleButton1.Value Then Call Lines_Add End If End Sub Private Sub xlApp_WorkbookBeforePrint(ByVal Wb As Workbook, Cancel As Boolean) Call Lines_Del End Sub Private Sub xlApp_WorkbookBeforeSave(ByVal Wb As Workbook, ByVal SaveAsUI As Boolean, Cancel As Boolean) Call Lines_Del End Sub
その他の回答 (4)
- pauNed
- ベストアンサー率74% (129/173)
こんにちは。 KenKen_SPさん、スゴいですね。勉強になります。ありがとうございました。m(_ _)m 私の環境でも使用できました。(win2000/xl2000) 他のwinXP/xl2003にもDirectX8は入ってましたので、 使える環境は多いのではないでしょうか。 #案外実用的かも^ ^ >vba_minaraiさんへ 蛇足ながら、Zoom補正ですが Option Explicit Private sx As Single Private sy As Single Sub 補正() Dim rng As Range With ActiveSheet On Error Resume Next .Ovals("oval_S").Delete On Error GoTo 0 Set rng = .Range("IV65536") Application.Goto rng With .Shapes.AddShape(msoShapeOval, rng.Left - 4, rng.Top - 4, 8, 8) .Name = "oval_S" .Fill.ForeColor.SchemeColor = 10 .OnAction = "center_click" End With End With Set rng = Nothing MsgBox "最終セルの赤丸 Click" End Sub Sub center_click() Dim xi As Single, yi As Single, n As Long On Error Resume Next Call GetCursorPos(MoP) With ActiveWindow n = .Zoom xi = (MoP.X - .PointsToScreenPixelsX(Range("A1").Left)) * 300 / (4 * n) yi = (MoP.Y - .PointsToScreenPixelsY(Range("A1").Top)) * 300 / (4 * n) End With With ActiveSheet.Ovals("oval_S") sx = .Left / xi sy = .Top / yi .Delete End With MsgBox "ok: " & sx & " / " & sy Application.Goto Range("A1") End Sub ...と係数になるようなものを取得しておいて With ActiveWindow n = .Zoom Ln = (MoP.X - .PointsToScreenPixelsX(Range("A1").Left)) * 300 / (4 * n) * sx Tn = (MoP.Y - .PointsToScreenPixelsY(Range("A1").Top)) * 300 / (4 * n) * sy End With ...とすればいいかもしれません。 もしかしたら自動で取得できるのかもしれませんが、わかりませんでした^ ^; (どこかでsxとsyの初期値を1にする処理が必要) (* 300 / (4 * n) は元の * 3 / 4 にZoomの%を掛け合わせただけです) また、セル選択を考慮するなら .Left = Ln + 3 .Top = Tn + 4 などと少し調整したほうがいいかもしれませんね。
- KenKen_SP
- ベストアンサー率62% (785/1258)
こんにちは。KenKen_SP です。 本来は、外部のツールを使った方が良いのかもしれません。 アイディアと一部コードは #1 の pauNed さんのものをお借りしましたm(_ _)m Do ~ Loop でマウスの位置を監視する方法だとキー入力がうまくできなかった ので、DirectInput を使ってみました。CPU 負荷はマウスを動かしているとき だけかかります。ただし、それなりにマシンスペックは必要です。 テスト環境は WindowsXP + DirectX8 + Excel2002 です。 また、私の PC には Visual Basic 6.0 がインストールされているのですが、 他環境ではテストしてません。きっと、VB がインストールされないとダメな気 がしますね...環境を著しく限定させてしまい実用的ではないです。 エラートラップはしてありますが、挙動不信なときもあるので、テストコード 扱いです。いきなり Excel がフリーズするかもしれません。十分ご注意下さい。 このような状況に加え、コメントはほぼ入れてませんし、コードの解説もできま せんので、この場で公開できるものなのか悩みましたが、面白そうなので参加し ちゃいます。 【手順】 0. VBE で DirextX x Visual Basic Type Library を参照設定 1. フォーム(Userform1)、標準モジュールをそれぞれ挿入 2. フォームに ToggleButton1 を配置 3. 以下のコードをそれぞれの場所にコピペ 4. Userform1 を下記のコードで開く Userform1.Show vbModeless それにしても....長すぎですね、すみませんm(_ _)m 【以下ソースコード】 '----------------- Userform1 フォームモジュール ----------------- Option Explicit ' 要参照設定 DirextX x Visual Basic Type Library Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _ ByVal lpClassName As String, _ ByVal lpWindowName As String _ ) As Long Private Declare Function GetCursorPos Lib "user32.dll" ( _ lpPoint As POINTAPI _ ) As Long Private Declare Function SetActiveWindow Lib "user32.dll" ( _ ByVal hwnd As Long _ ) As Long Private Type POINTAPI X As Long Y As Long End Type Private MoP As POINTAPI Private mhWnd As Long Private mSh As Worksheet Private mLine_H As Shape Private mLine_V As Shape ' DirectInput Implements DirectXEvent8 Private mDX As DirectX8 Private mDI As DxVBLibA.DirectInput8 Private mDIDevM As DxVBLibA.DirectInputDevice8 Private mhEventM As Long Private Const MAX_BUFFERSIZE As Long = 10 ' Private Sub UserForm_Initialize() ' フォーム・コントロールの初期化 With Me .Width = 80: .Height = 40 End With With Me.ToggleButton1 .Top = 0: .Left = 0 .Width = Me.InsideWidth: .Height = Me.InsideHeight .Caption = "Cross Cursol Off" End With On Error GoTo ERROR_HANDLER ' Userform のウインドウハンドル mhWnd = FindWindow("ThunderDFrame", Me.Caption) If mhWnd > 0 Then Call InitDirextInput Else Err.Raise 1000, , "Userform の hWnd が取得できませんでした" Unload Me End If Set mSh = ActiveSheet Exit Sub ERROR_HANDLER: Set mDIDevM = Nothing Set mDI = Nothing Set mDX = Nothing Set mSh = Nothing MsgBox Err.Description, vbExclamation End Sub Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) ' ライン消去 Call Lines_Del ' アクセス権を破棄してオブジェクトの参照を開放 If Not mDIDevM Is Nothing Then mDIDevM.Unacquire End If Set mDIDevM = Nothing Set mDI = Nothing Set mDX = Nothing Set mSh = Nothing End Sub Private Sub ToggleButton1_Change() Dim i As Long With Me.ToggleButton1 If .Value Then With Application .Cursor = xlNorthwestArrow .StatusBar = "" 'チラつくので消しておく End With .Caption = "Cross Cursol On" ' ライン描写 Call Lines_Add Call LineMove ' アクセス権取得 If Not mDIDevM Is Nothing Then mDIDevM.Acquire End If Else Call Lines_Del With Application .Cursor = xlDefault .StatusBar = False End With ' アクセス権破棄 .Caption = "Cross Cursol Off" On Error Resume Next mDIDevM.Unacquire ' 待機(簡易ウェイト...なんかうまく開放されない時があるので2回試す) For i = 1 To 500000: DoEvents: Next i mDIDevM.Unacquire On Error GoTo 0 Call SetActiveWindow(FindWindow("XLMAIN", vbNullString)) End If End With End Sub Private Sub InitDirextInput() Set mDX = New DxVBLibA.DirectX8 Set mDI = mDX.DirectInputCreate() If mDI Is Nothing Then Err.Raise 1000, , "DirectInput オブジェクト生成に失敗しました." End If Set mDIDevM = mDI.CreateDevice("guid_SysMouse") If mDIDevM Is Nothing Then Err.Raise 1000, , "DirectInputDevice オブジェクト生成に失敗しました." Else mDIDevM.SetCommonDataFormat DIFORMAT_MOUSE2 mDIDevM.SetCooperativeLevel mhWnd, DISCL_BACKGROUND Or DISCL_NONEXCLUSIVE Dim diprop As DxVBLibA.DIPROPLONG With diprop .lHow = DIPH_DEVICE .lObj = 0 .lData = 10 End With mDIDevM.SetProperty "DIPROP_BUFFERSIZE", diprop mhEventM = mDX.CreateEvent(Me) mDIDevM.SetEventNotification mhEventM End If End Sub ' DirectX イベント Private Sub DirectXEvent8_DXCallback(ByVal eventid As Long) Dim X As Long Dim lngX As Long Dim lngY As Long Select Case eventid Case mhEventM ' マウスイベント Dim devdata(MAX_BUFFERSIZE - 1) As DxVBLibA.DIDEVICEOBJECTDATA Dim datacnt As Long On Error Resume Next datacnt = mDIDevM.GetDeviceData(devdata, DIGDD_DEFAULT) If Err Then datacnt = 0 mDIDevM.Acquire End If On Error GoTo 0 For X = 0 To datacnt - 1 With devdata(X) Select Case .lOfs Case DIMOFS_X, DIMOFS_Y ' X軸、Y軸の移動 Call LineMove Case Else End Select End With Next Case Else End Select End Sub Private Sub LineMove() Dim sglL As Single Dim sglT As Single If Not mSh Is ActiveSheet And Me.ToggleButton1.Value Then Call Lines_Add Set mSh = ActiveSheet Else On Error Resume Next Call GetCursorPos(MoP) sglL = (MoP.X - ActiveWindow.PointsToScreenPixelsX _ (Range("A1").Top)) * 3 / 4 sglT = (MoP.Y - ActiveWindow.PointsToScreenPixelsY _ (Range("A1").Left)) * 3 / 4 mLine_V.Left = sglL mLine_H.Top = sglT End If End Sub Private Sub Lines_Add() Dim sglW As Single, sglH As Single On Error GoTo ERROR_HANDLER Call Lines_Del sglW = Range("IV1").Left + 500 sglH = Range("A65536").Top + 500 Set mLine_H = Nothing Set mLine_V = Nothing Set mLine_H = ActiveSheet.Shapes.AddLine(0#, 10#, sglW, 10#) With mLine_H .Name = "$CurLine_H$" & .Name .Line.Weight = 1 .Line.Style = msoLineSingle .Line.ForeColor.SchemeColor = 48 End With Set mLine_V = ActiveSheet.Shapes.AddLine(10#, 0#, 10#, sglH) With mLine_V .Name = "$CurLine_V$" & .Name .Line.Weight = 1 .Line.Style = msoLineSingle .Line.ForeColor.SchemeColor = 48 End With Exit Sub ERROR_HANDLER: MsgBox "ライン描写に失敗しました.", vbExclamation End Sub '----------------- 標準モジュール --------------------------------- Option Explicit ' ユーザーにもラインを消せるように、標準モジュールにおく Sub Lines_Del() Dim Wb As Workbook Dim Sh As Worksheet Dim shpLine As Shape On Error Resume Next For Each Wb In Workbooks For Each Sh In Wb.Worksheets For Each shpLine In Sh.Shapes If shpLine.Name Like "$CurLine_*" Then shpLine.Delete End If Next shpLine Next Sh Next Wb End Sub
- pauNed
- ベストアンサー率74% (129/173)
すみません。おすすめしないとはいえ、中途半端すぎました^ ^; とりあえずZoom=100ならこれで大丈夫なはず。 Sub Lin_Cursor() Dim Tn As Single, Ln As Single Application.Cursor = xlNorthwestArrow Application.StatusBar = "Lin_Cursor On" Do DoEvents GetCursorPos MoP With MoP Ln = (.x - ActiveWindow.PointsToScreenPixelsX _ (Range("A1").Left)) * 3 / 4 Tn = (.y - ActiveWindow.PointsToScreenPixelsY _ (Range("A1").Top)) * 3 / 4 End With If Not Lflg Then Exit Do With ActiveSheet.Lines("line_H") .Top = Tn .Left = Ln - 1500 .Width = 3000 End With With ActiveSheet.Lines("line_v") .Top = Tn - 1000 .Left = Ln .Height = 2000 End With Loop Application.Cursor = xlDefault Application.StatusBar = False End Sub また、最低限↓これは必要でした。 '■ThisWorkbookモジュール Private Sub Workbook_Deactivate() 解除 End Sub Private Sub Workbook_SheetDeactivate(ByVal Sh As Object) 解除 End Sub
- pauNed
- ベストアンサー率74% (129/173)
こんにちは。サンプルですが、触りだけ^ ^ '■標準モジュールに Option Explicit Private Lflg As Boolean Private Type POINTAPI x As Long y As Long End Type Private Declare Function GetCursorPos Lib _ "user32.dll" (lpPoint As POINTAPI) As Long Private MoP As POINTAPI, GetX As Single, GetY As Single Sub Lines_Add() 'LineShapeをつくる。初回のみ With ActiveSheet On Error Resume Next .Lines("line_H").Delete .Lines("line_V").Delete On Error GoTo 0 With .Lines.Add(0, 0, 3000, 0) .Name = "line_H" With .ShapeRange.Line .Weight = 1 .Style = msoLineSingle .ForeColor.SchemeColor = 48 End With End With With .Lines.Add(0, 0, 0, 2000) .Name = "line_V" With .ShapeRange.Line .Weight = 1 .Style = msoLineSingle .ForeColor.SchemeColor = 48 End With End With End With End Sub Sub スタート() Lflg = True Lin_Cursor End Sub Sub 解除()'ボタンやショートカットキーやイベントに割り当てたり。 Lflg = False End Sub Sub Lin_Cursor() '本体。Constは環境によって調整必要。 Dim Tn As Single, Ln As Single Const yi As Single = 103 'シート上のy座標の初期修正値。 Const xi As Single = 28 'シート上のx座標の初期修正値。 Const N As Single = 1.336 '係数のようなもの。 Application.Cursor = xlNorthwestArrow Application.StatusBar = "Lin_Cursor On" Do DoEvents With ActiveWindow.VisibleRange GetCursorPos MoP Tn = (MoP.y - yi) / N + .Top Ln = (MoP.x - xi) / N + .Left End With With ActiveSheet.Lines("line_H") .Top = Tn .Left = Ln - 1500 .Width = 3000 End With With ActiveSheet.Lines("line_v") .Top = Tn - 1000 .Left = Ln .Height = 2000 End With Loop Until Not Lflg Application.Cursor = xlDefault Application.StatusBar = False End Sub ウィンドウのサイズや位置の変更によって、またツールバーの高さによっても位置がずれますので、 少し工夫が必要ですね。 DoLoopで常にマクロ実行しているわけですから、CPU負担も高いし、 入力時には解除しないといけないので基本的にはおすすめしません。 MauseMoveではなくて、Cell選択時の動作でよければWorksheet_SelectionChangeを使って、 A)条件付き書式と組み合わせる方法。 B)Lineシェイプを使う方法。 などがあります。特定のシートだけなら比較的簡単です。 参考URLのリンク先も辿ってみてください。
関連するQ&A
- エクセル (1)行削除 (2)列追加と計算式入力
エクセル マクロで自動で計算させたいのですが、マクロの記録しかやったことがない者です。 添付画像のように、 元のデータとして、A列に黄色のセルがある表があります。 やりたいことは2種類あって (1):A列に黄色がある行のみを残す。 (1)-1:(1)をやった後に、列を追加し、計算式をデータがある行分だけ入力して計算させる。 (2):A列が無色の行のみを残す。 (2)-1:(2)をやった後に、列を追加し、計算式をデータがある行分だけ入力して計算させる。 (1)、(1)-1と、(2)、(2)-1それぞれのマクロを教えてください。 色の指定の違いだけになるかと思いますが、良く判らないので、お願いいたします。 また、例えば赤色などへの変更も可能か、教えて欲しく。 行を残す内容と、列追加や、計算式入力等、それぞれ判るように、コメント行を入れていただけると助かります。 申し訳ありませんが、お願いいたします。
- ベストアンサー
- オフィス系ソフト
- エクセル 表の行と列
すみませんが、ご教授願います。 Excelで作成した表の行と列の説明で次のうち間違いはどれか 1.行と列を入れ替えて新たな表を作成するときは 行と列を入れ替える機能を使うと便利である 2.行や列のセルを対象にしての関数計算の際、行や列を 非表示にするとエラーメッセージが出て計算が出来ない 3.ある行や列を非表示にして印刷する際 非表示にした部分は印刷されない 4.現在のシートの行と列の表示を 右から左へ表示することが出来る
- ベストアンサー
- その他([技術者向] コンピューター)
- Excel 2007 マクロ セルの色のカウント
Excel 2007 マクロ セルの色のカウント 表に複数の色がセルについています。 色がついているセルの隣の列に「1」を返したいです。 どのようなマクロになりますでしょうか。 色がついている列は1行でC列になります。 ご回答よろしくお願いします。
- ベストアンサー
- その他MS Office製品
- A列に特定の文字を入力したら、その行に色がつくようにしたい
はじめまして。 会社のエクセル2000で、マクロの勉強をしております。 現在事務作業用に表を作っているのですが、下記のことが うまくできません。 ・A列に"済"と入力したら、その行を("済"と入力された行)、 黄色に。 ・A列に"棄"と入力したら、その行を("棄"と入力された行)、 グレーに。 ・A列に入力した文字を消した場合、行の色も空白に戻る。 このようにする為にはどのようにすれば良いでしょうか? よろしくお願いいたします。
- 締切済み
- Visual Basic
- すでに入力されている数字で計算をしたい
数字が入力されている表があります D列E列F列の数字をそれぞれB列の数字で割り算をしたいと考えています 割り算の答えは同じそのセルに上書きするようにします 別のセルで計算した結果を値貼り付けでもってきていたのですが、 マクロで処理できればと考えております 2行目から数字が入力されているのですが、 最終行が決まっておりません。 答えは全て小数点第2位までで表示したいと考えています どなたかご教授いただけますでしょうか よろしくお願い致します
- ベストアンサー
- オフィス系ソフト
- ホームページビルダー14で、表の外枠だけに(たとえば、5列、4行の表の
ホームページビルダー14で、表の外枠だけに(たとえば、5列、4行の表の一番外の外周枠)に色をつける方法を教えて下さいませんか。また、表内の特定セル(左から二つ目、上から二つ目のセル)の枠線だけに色をつける方法があれば一緒に教えてくださいませんでしょうか。よろしくお願いします。
- ベストアンサー
- ホームページ作成ソフト
- エクセルの行の色を変える
こんにちはtmgmです。 エクセルの使い方でちょっとわからない部分があって困っています。 今、2行3列(A1~C2の6つのセル)の表があるとします。このときC1セルに数字を1と入力したら1行目の色が赤くなるようにするにはどうすればよいのでしょうか? 自分的には条件付書式やif関数等を駆使すればできるんではなかろうかとおもっているのですが、チャレンジするもののいまいちわかりません。 どなたかお分かりになる方いらっしゃいますでしょうか? ご返答よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- Excelの表で、行と列の見出しを、そっくりそのまま入れ替えたい。
Microsoft Excel2000(OS=Win・XP)で表(表の内容は賃金センサスです。)を作成しているのですが、行と列の見出しをそのまま入れ替えて、セルもちゃんと内容に合うように、自動的に入れ替わるような方法って無いでしょうか???もし方法があれば誰か教えて下さい~! (↓表の状態です) ・ワークシートは、入力用・印刷用1・印刷用2の、合計3つがあります。 ・入力用と印刷用1のワークシートは、”行が年齢、列が年度”となっています。 ・印刷用2のワークシートは、”行が年度、列が年齢”となっています。 ・印刷用1のワークシートのセルには、計算式を入れてあり、入力用のワー クシートのセルに入力すると、ある計算をして、自動的に数字が表示され るようにしています。 ・印刷用2のワークシートのセルには、計算式はまだ入れていません。 →印刷用1も2も、列と行が交差するセルの内容は同じだし、どうにか簡単に印刷用2を作成できないかとおもっているのです。
- ベストアンサー
- オフィス系ソフト
- エクセル:列の範囲選択をうまくできないでしょうか ?
行数が約2000行ほどの表を毎月使用します。それでいろんな列をコピーして別の表に貼り付けたいのですが、列のコピーをする時に範囲指定でドラッグに結構時間がかかります。これをマクロでやりたいんですが、カーソルをおいた列の一番下の行まで範囲を指定すると言うのをマクロでできないでしょうか? 自動記録でマクロを造ろうとすると、実行した列を選択してしまい、任意の列の選択ができません。 よろしくおねがいします。
- ベストアンサー
- オフィス系ソフト
- エクセル2000で集計行に色をつける
エクセルの縦に長い表があります。 途中、ところどころが集計行、一番下が総合計です。 以前、こちらで教えていただいた「集計」機能で作成したものです。 今回の質問は、その集計行のセルに色をつける方法です。 集計行のE列には必ず「○○ 計」の文字列がありますから、これを判別して、B列からE列まで色をつけるVBAまたは、便利な方法がありましたら教えてください。 よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
お礼
いつも、いつも有難う御座います。 とてもいいものを作って頂いて、色々と活用していきたいと思います。本当に有難う御座いました。