よく使うExcelVBA

書式操作

セル幅

条件付書式

 ・

 ・

サイズ

色の一覧

 RGB 参考サイト

 color 参考サイト

 colorindex 参考サイト

色取得

転記

リンク操作

クリック操作

  • ダブルクリックで色つけ
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 'BeforeDoubleClick, Cancel As Boolean

If Not Application.Intersect(ActiveCell, Range("C3:C1500")) Is Nothing Then
    Cancel = True '入力無効
    With ActiveCell.Interior
        If .ColorIndex = xlNone Then
          .ColorIndex = 38
        ElseIf .ColorIndex = 38 Then
          .ColorIndex = 36
        ElseIf .ColorIndex = 36 Then
          .ColorIndex = 35
        ElseIf .ColorIndex = 35 Then
          .ColorIndex = xlNone
        End If

    End With
End If
  • クリックで文字入れ
  • クリックで文字転記
シート名は変えて使ってください。
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 'BeforeDoubleClick, Cancel As Boolean

If Not Intersect(Target, Range("D3:D1500")) Is Nothing Then
    S_title = Target.Offset(0, -2).Value & Target.Offset(0, -1).Value
    S_jyo = Target
    ri = ActiveCell
    S_dai = ActiveCell.Offset(0, -2).Value
    Target.Offset(0, 1).Copy
    Debug.Print S_jyo
  k = 1

    Do While Worksheets("問題出力先").Range("B" & k) <> ""
        k = k + 1
        If Worksheets("出力先").Range("B" & k) = "" Then
            Worksheets("出力先").Range("A" & k) = S_title
            Worksheets("出力先").Range("B" & k) = S_jyo
            'Worksheets("出力先").Range("C" & K) = S_con
            Worksheets("出力先").Range("C" & k).PasteSpecial (xlPasteAll)
            'Worksheets("出力先").Range("D" & k) = S_con
            Debug.Print
            MsgBox "出力先に追加しました"
             Cancel = True '入力無効
          Exit Do
        End If
    Loop

End If

ユーザフォーム操作

If Not Intersect(Target, Range("F3:F300")) Is Nothing Then
    
  Cancel = True
  Dim Tx1 As Long, Lx1 As Long, Wx1 As Long, Hx1 As Long
With ActiveWindow
  Tx1 = .Top
  Lx1 = .Left
  Wx1 = .Width
  Hx1 = .Height
End With

' ** ユーザーフォームをロード
Load インデックス

'** UFのサイズを取得
Dim Tx2 As Long, Lx2 As Long, Wx2 As Long, Hx2 As Long
With インデックス
  Wx2 = .Width
  Hx2 = .Height
End With

'** ユーザーフォームの表示位置を計算
Tx2 = Tx1 + ((Hx1 - Hx2) / 2)
Lx2 = Lx1 + ((Wx1 - Wx2) / 2)

'** ユーザーフォームを表示
With インデックス
  .StartUpPosition = Manual  '**Top,Leftを指定するときに必ず必要
  '                             これがないとLeftがずれます
  .Left = Lx2                '**X座標
  .Top = Tx2                 '**Y座標
  .Show                      '**ユーザーフォームを表示
End With
End If
  • 文字置換  
  • 指定文字で色つけ 
  • 色一覧  
  • フィルタ機能  重複なし
                                                 
Dim items() As Variant
Dim i As Integer
Dim tmp As String
Dim itemsStr As String
tmp = ""
itemsStr = ""
' 商品名取得
items = WorksheetFunction.Transpose(Range("B6:B13").Value) ★
' 重複しない商品名をカンマ区切り文字列に変換
For i = 1 To UBound(items)
    If tmp <> items(i) Then
        itemsStr = itemsStr & items(i) & ","
        tmp = items(i)
    End If
Next
' ドロップダウンリスト作成
With Range("B3").Validation
     .Delete
     .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:=Left(itemsStr, Len(itemsStr) - 1)
End With
  • ワード表へ転記  

グラフ操作

グラフの適用

Sub Sample()
    Dim LastCell As Range, i As Long
    Set LastCell = Cells(Rows.Count, 1).End(xlUp)
    With ActiveSheet.ChartObjects(1).Chart
        For i = 1 To .SeriesCollection.Count
            .SeriesCollection(i).Formula = _
                "=SERIES(" & Cells(1, i + 1).Address(External:=True) & "," & _
                 Range(Cells(2, 1), LastCell.Offset(0, 0)).Address(External:=True) & "," & _
                 Range(Cells(2, i + 1), LastCell.Offset(0, i)).Address(External:=True) & "," & _
                 i & ")"
        Next i
    End With
End Sub

「ActiveChart.Parent」と.Nameの組み合わせ

コメント

タイトルとURLをコピーしました