EXCEL2000 VBA 上に移動 [Excel2000 VBA独習]
EXCEL2000 VBA 上に移動
再生できない場合、ダウンロードは🎥こちら
追記 複数列に対応
EXCEL2000 VBA 選択範囲(1列)の重複を取り除いて右側に表示する。 実験 [Excel2000 VBA独習]
EXCEL2000 VBA 選択範囲(1列)の重複を取り除いて右側に表示する。 実験
追記
一応 使えるかも?バージョン
EXCEL2000 VBA 最終行を調べる関数を作った。 [Excel2000 VBA独習]
EXCEL2000 VBA 最終行を調べる関数を作った。
Excelの関数で、空白の有る列の最終入力の有る行番号を調べる関数がない?ので作ってみた。
Excelでは
=OFFSET(B1,COUNTA(B:B)-1,0)
=INDEX($B:$B,COUNTA($B:$B),1)
=MAX(INDEX((LEN(A1:A65534)>0)*ROW(A1:A65534),0)) 空白が有ってもOK
な感じで最終行を調べる(空白が有ると上手くいかない)
Function last_rowN(col As Variant)
'最終行番号を返す
last_rowN = Cells(65536, col).End(xlUp).Row
End Function
作り方
ブックを新規作成
VBEを起動して上記のコードを記入
ファイル名を****.xla で保存
Excelのメニューバー→ツール→アドイン で、ダイアログの参照ボタンを押し先ほど保存したxlaファイを選択しアドインにする
Excel なら A列の最終行番号を調べるには、=last_rowN("A")、=last_rowN(1)とセルに記入
VBA なら a=last_rowN(selection.column)
本当は、=SUM(A1:"A" & last_rowN("A")) のように利用したかったが、エラーが出てダメだった、残念
追記
関数名をlast_rowN から last_row に変更
="A" & TEXT(last_row("A"),0) はOK
=sum("A1":("A" & TEXT(last_row("A"),0))) はNG
A2から入力のある最終行まで選択(可変範囲指定で、エクセルの関数を駆使して作るより簡単!)
=OFFSET(List!$A$2,0,0,last_row("A"),1)
追記型名前範囲に使うと便利
=SUM(OFFSET(A1,0,0,last_row(1),1)) こんな使い方もできる。
EXCEL2000 VBA XLSTARTフォルダとExcel.libを世代間バックアップする実験 [Excel2000 VBA独習]
EXCEL2000 VBA XLSTARTフォルダとExcel.libを世代間バックアップする実験
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
一応完成
EXCEL2000 VBA ハイパーリンク一覧を作成する 実験 [Excel2000 VBA独習]
EXCEL2000 VBA ハイパーリンク一覧を作成する 実験
Sub シートのハイパーリンク一覧()
'
Dim newS As Worksheet '
Dim aSname As String '選択しているシート名
Dim newSname As String '新しく作るシート名
Dim i As Long '汎用
Dim msg As Variant 'vbyesyno の値
'一覧を作成するシートをすぐ後に作る(シート名は選択シート+”HL一覧”)
aSname = ActiveSheet.Name 'シート名
'シート名の確認
msg = MsgBox("アクティブシート名は " & aSname & "です。" & vbCrLf & vbCrLf & "このシートのハイパーリンク一覧を作成しますか?", vbYesNo)
Select Case msg
Case vbYes
GoTo yes
Case vbNo
MsgBox "処理を終了します。シートを選択し直してから実行してください"
Exit Sub
End Select
yes:
'同一のシート名があるか調べる(同一のシート名があったらシートセル全体の値を消す)
For i = 1 To ActiveWorkbook.Sheets.Count
If ActiveWorkbook.Sheets(i).Name = aSname & "HL一覧" Then ActiveWorkbook.Sheets(i).Cells.Delete: GoTo make
Next i
'新しくシートを作成
Worksheets.Add(After:=Worksheets(ActiveSheet.Name)).Name = aSname & "HL一覧"
'
'シートのハイパーリンク一覧を作成
make:
newSname = Worksheets(aSname).Name & "HL一覧"
For i = 1 To Worksheets(aSname).Cells.Hyperlinks.Count
Worksheets(newSname).Cells(i, 1) = Worksheets(aSname).Hyperlinks(i).Range.Address 'アドレス $A$1
Worksheets(newSname).Cells(i, 2) = Range(Worksheets(aSname).Hyperlinks(i).Range.Address).Value 'セルの値
Worksheets(newSname).Cells(i, 3) = Worksheets(aSname).Hyperlinks(i).Address 'ハイパーリンクの値
Next i
'作成したハイパーリンク一覧をセレクトしセル幅を整える
Worksheets(newSname).Cells.EntireColumn.AutoFit
End Sub
Worksheets("Excel関数").Hyperlinks.Delete はできる
Worksheets("Excel関数").Hyperlinks=False はできない ?
EXCEL2000 VBA ハイパーリンクの有るセルを選択出来ないようする 実験(失敗)その2 [Excel2000 VBA独習]
EXCEL2000 VBA ハイパーリンクの有るセルを選択出来ないようする 実験(失敗)その2
http://telstar.blog.so-net.ne.jp/2012-10-17-1 のつづき
ハイパーリンクの設定文字列に [']を一文字目に付加し選択するとエラーダイアログを表示する(表示したくはないが)。
ハイパーリンクが不適切なので開く事は無い。
もう一度マクロを実行すると有効にできる。
Sub ハイパーリンクを有効無効()
'ハイパーリンクが設定されてるセルの値に「’」シングルクオーテーションを付加して
'無効にする。(エラーにする)警告ダイアログがでる
'有効にするには、「’」シングルクオーテーションを削除する
'
Dim HLcount As Long 'ハイパーリンクの個数
Dim Raddress As String 'ハイパーリンクのあるセルアドレス
Dim HL_address As String 'ハイパーリンク内容
Dim i As Long 'カウンター用
'選択シートに設定されているハイパーリンクの個数を調べる
HLcount = ActiveSheet.Cells.Hyperlinks.Count
'ハイパーリンクが無ければ終了、
If HLcount = 0 Then Exit Sub
'ハイパーリンクの文字列の最初の文字が[']か調べる
If Left((ActiveSheet.Hyperlinks(1).Address), 1) = "'" Then GoTo 有効 Else GoTo 無効
無効:
'ハイパーリンクの値に「 ' 」を文字列の先頭つける
For i = 1 To HLcount
Raddress = ActiveSheet.Hyperlinks(i).Range.Address
HL_address = "'" & ActiveSheet.Hyperlinks(i).Address
' [']を付加した文字列をハイパーリンクに設定
ActiveSheet.Hyperlinks.Add Anchor:=Range(Raddress), Address:=HL_address
Next i
Exit Sub
有効:
'ハイパーリンクを調べる
For i = 1 To HLcount
Raddress = ActiveSheet.Hyperlinks(i).Range.Address
' 付加した[']を削除
HL_address = Right(ActiveSheet.Hyperlinks(i).Address, Len(ActiveSheet.Hyperlinks(i).Address) - 1)
ActiveSheet.Hyperlinks.Add Anchor:=Range(Raddress), Address:=HL_address
Next i
End Sub
感想
まぁいいか~ ← 子供みたいだねぇ (小倉さん風)
追記
Sub ハイパーリンクを有効無効()
'ハイパーリンクが設定されてるセルの値に「’」シングルクオーテーションを付加して
'無効にする。(エラーにする)警告ダイアログがでる
'有効にするには、「’」シングルクオーテーションを削除する
'
Dim HLcount As Long 'ハイパーリンクの個数
Dim Raddress As String 'ハイパーリンクのあるセルアドレス
Dim HL_address As String 'ハイパーリンク内容
Dim i As Long 'カウンター用
Dim mymesse As String 'メッセージ文字列
'選択シートに設定されているハイパーリンクの個数を調べる
HLcount = ActiveSheet.Cells.Hyperlinks.Count
'ハイパーリンクが無ければ終了、
If HLcount = 0 Then Exit Sub
'ハイパーリンクの文字列の最初の文字が[']か調べる
If Left((ActiveSheet.Hyperlinks(1).Address), 1) = "'" Then GoTo 有効 Else GoTo 無効
無効:
'ハイパーリンクの値に「 ' 」を文字列の先頭つける
For i = 1 To HLcount
Raddress = ActiveSheet.Hyperlinks(i).Range.Address
HL_address = "'" & ActiveSheet.Hyperlinks(i).Address
' [']を付加した文字列をハイパーリンクに設定
ActiveSheet.Hyperlinks.Add Anchor:=Range(Raddress), Address:=HL_address
Next i
mymesse = "ハイパーリンクを不正にしました"
MsgBox mymesse
'ステータスバーに状態表示
Application.StatusBar = mymesse
Exit Sub
有効:
'ハイパーリンクを調べる
For i = 1 To HLcount
Raddress = ActiveSheet.Hyperlinks(i).Range.Address
' 付加した[']を削除
HL_address = Right(ActiveSheet.Hyperlinks(i).Address, Len(ActiveSheet.Hyperlinks(i).Address) - 1)
ActiveSheet.Hyperlinks.Add Anchor:=Range(Raddress), Address:=HL_address
Next i
mymesse = "ハイパーリンクを戻しました"
MsgBox mymesse
MsgBox mymesse
'ステータスバーに状態表示
Application.StatusBar = mymesse
End Sub
EXCEL2000 VBA シートを隠す 実験 [Excel2000 VBA独習]
EXCEL2000 VBA シートを隠す 実験
メニューバーの 書式→シート→再表示 可能
Sub シート非表示()
Worksheets("Sheet1").Visible = False
End Sub
Sub シートを隠す再表示可()
' シートを隠す(ツールバーの再表示可)
Worksheets("sheet1").Visible = xlHidden ' ←非表示
End Sub
メニューバーの 書式→シート→再表示 不可
Sub シートを隠し再表示させない()
' シートを隠す(ツールバーの再表示に表示させない)
'
Worksheets("sheet1").Visible = xlVeryHidden
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
表示する
Sub シート表示()
Worksheets("sheet1").Visible = True
End Sub
Sub 隠したシートを再表示()
' 隠したシートを再表示
Worksheets("sheet1").Visible = xlSheetVisible
Worksheets("Sheet1").Select
End Sub
参照サイト ttp://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_020.html
-------------------------------------------------------------------------------------
追記 隠しシート一覧をメッセージボックスに表示、(出来が悪い)
Sub 隠しシート一覧()
Dim i As Long '汎用カウンタ
Dim d() As String 'シート名配列
Dim sheetC As Long 'bookのシート数
Dim msgS As String 'msgbox用文字列
'bookのシート数を調べる
sheetC = ActiveWorkbook.Sheets.Count
'配列d 個数設定
ReDim d(sheetC)
'シートが非表示常態か調べる
For i = 1 To sheetC
If ActiveWorkbook.Sheets(i).Visible = False Or ActiveWorkbook.Sheets(i).Visible = xlVeryHidden Then d(i) = Sheets(i).Name
Next i
For i = 1 To sheetC
msgS = msgS & d(i) & vbCrLf
Next i
MsgBox msgS
End Sub
▼非表示シートを確認しながら再表示するマクロ ttp://www.relief.jp/itnote/archives/001295.php
Sub シートを再表示する()
Dim s As Object
Dim ret As Long
For Each s In ActiveWorkbook.Sheets
With s
If .Visible = False Then
ret = MsgBox( _
"シート『" & .Name & "』を再表示しますか?", _
vbYesNo)
If ret = vbYes Then .Visible = True
End If
End With
Next s
EXCEL2000 VBA ハイパーリンクの有るセルを選択出来ないようする 実験(失敗) [Excel2000 VBA独習]
EXCEL2000 VBA ハイパーリンクの有るセルを選択出来ないようする 実験
上の画像のように、関数HELPを作ったいるけどハイパーリンクの有るセルを選択して設定URLに飛んでしまうので困る時と、リンクを開きたい時がある。
開く、開かないはシートイベントの有効無効で切り替える事にする。
関連記事 http://telstar.blog.so-net.ne.jp/2011-09-06
シートは下のURLを利用した。
ttp://www.eurus.dti.ne.jp/~yoneyama/Excel/kansu/itiran.html
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'ハイパーリンクの有るセルを選択したら下に移動
'シートにこのマクロを設定
'シート名を右クリック「コードの表示」
'ttp://www.excel.studio-kazu.jp/mag2/backnumber/mm20040727.html
If Target.Hyperlinks.Count > 0 Then ' Targetにハイパーリンクcountがあれば
ActiveCell.Offset(1, 0).Select ' ActiveCellの一つ下へ
End If
End Sub
の、コードをシートマクロに記述する。
結果
マウスで選択すると、リンク先に飛ぶ、キーボードで選択した時は選択出来ないで下に移動する
ハイパーリンクの有るセルを選択出来ないようする、いい方法はないかなぁ
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
ハイパーリンク関連資料
Sub ハイパーリンクの全削除()
'選択シートのハイパーリンクを全部削除する。
ActiveSheet.Cells.Hyperlinks.Delete
End Sub
for i=1 to ActiveSheet.Hyperlinks.Count
Cells(i, 1) = ActiveSheet.Hyperlinks(i).Range.Address 'セルのアドレス
Cells(i, 2) = ActiveSheet.Hyperlinks(i).Address 'リンクのアドレス
next i
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
昼休みに考えた
ハイパーリンク一覧を別シートに作成 (セルアドレス、リンク内容)
無効にする ハイパーリンクの削除
有効にする ハイパーリンク一覧からハイパーリンクを設定する
近日公開予定
EXCEL2000 VBA 文字の配置、縦配置を中央揃え [Excel2000 VBA独習]
EXCEL2000 VBA 文字の配置、縦配置を中央揃え
ツールバーには、横方向の中央揃えのボタンは有るが、縦方向のは無いので?作った。
マクロで記録し利用する。
マクロの記録では下記のコードになる。
Sub Macro3()
'
' Macro3 Macro
' マクロ記録日 : 2012/10/17 ユーザー名 :
'
'
Range("B1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
End Sub
これに手を加えて下記のようにする。
不要なところは消してもいいが、一応のこしてコメントにする。
Sub 縦配置中央()
'
'
With Selection
' .HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
' .WrapText = False
' .Orientation = 0
' .AddIndent = False
' .ShrinkToFit = False
' .MergeCells = False
End With
End Sub
このマクロをツールバーに登録する。
EXCEL2000 VBA 選択範囲をHTMLとして保存する実験 [Excel2000 VBA独習]
EXCEL2000 VBA 選択範囲をHTMLとして保存する実験
Excel でhtmlで保存する操作をマクロに記録して利用した。
Sub 選択範囲HTML保存()
'
'選択範囲をHTMLで保存する
'
Dim saveDir_name As String '保存ディレクトリ、ファイル名
saveDir_name = "D:\nokie_bk\office\selectionHTML.html"
'
ActiveWorkbook.PublishObjects.Add(xlSourceRange, saveDir_name, ActiveSheet.name, Selection.Address, xlHtmlStatic, "", "").Publish _
(True)
End Sub
ソース
Excel2000VBA 選択セルから入力の有る最終行を選択する実験 [Excel2000 VBA独習]
Excel2000VBA 選択セルから入力の有る最終行を選択
入力の有る最終行を 調べるには Range("A" & Rows.count)End(slUp).Row のようにするが、列をアルファベットにしなえらばならない。
そこで、Selection.Column で調べた列番号(数字)アルファベットに変換する方法を検索して調べたら下記のようにすると変換できる。(但しA-Zまで)Excel のAA-IVに変換は出来ない。
参考サイト ttp://home.kanto-gakuin.ac.jp/~ahero/excel/vba/cell/cellActive.shtml
AA-IV列に対応できないが、一応作ってみた。
Sub 選択列の最終行まで選択()
'選択セル列の入力ある最終行まで選択する
'データ途中に空白があってもOK
'セル番号の数値からアルファベットへの変換 (A-Z列まで)
'ttp://home.kanto-gakuin.ac.jp/~ahero/excel/vba/cell/cellActive.shtml
Dim end_row As Long '入力のある最終行番号
'
'end_row=Range("A" & Rows.count)End(slUp).Row
'列番号をアルファベットに変換 Chr(Asc("A") - 1 + ActiveCell.Column)
'選択されているセルの最終行 65536行から上方向調べ最初見つかったセル行番号
end_row = Range(Chr(Asc("A") - 1 + Selection.Column) & Rows.Count).End(xlUp).Row
'範囲選択
Range(Cells(Selection.Row, Selection.Column), Cells(end_row, Selection.Column)).Select
End Sub
------------------------------------------
以上の様な間抜けな事をしたので、もっとまともなマクロを作った。
Sub 選択セル列の最終行まで選択()
Range(Selection(1), Cells(Rows.Count, Selection.Column).End(xlUp)).Select
End Sub
------------------------------------------
左上(selection(1)の入力の有る最終行を基準に複数列を選択
B10:C10を選択しマクロ実行画面
完成
Sub 選択セル列の最終行まで選択()
Range(Selection(1), Cells(Rows.Count, Selection.Column).End(xlUp).Offset(0, Selection.Columns.Count-1)).Select
End Sub
追記
Ctrl +Shift + ↓で範囲選択するのと、どこが違うか?
Ctrl +Shift + ↓ では、空白セルの手前までしか選択できないが、上のマクロでは空白が途中にあっても入力のある最終行まで選択できる。
資料
Ctrl +Shift + ↓の動作をマクロで記録すると Range(Selection, Selection.End(xlDown)).Select
Excel2000VBA 選択範囲をソートする実験 [Excel2000 VBA独習]
Excel2000VBA 選択範囲をソートする実験
Sub 選択範囲ソート2()
'あらかじめ範囲を選択する
'参考サイト ttp://excelvba.pc-users.net/fol7/7_4.html
'昇順で並べ替え「A~Z」、数値の場合は「0~9」
'降順で並べ替え「Z~A」、数値の場合は「9~0」
'------------------------------
'アクティブシートの選択範囲をソート(ソートキーを左上)
ActiveSheet.Range(Selection.Address).Sort Key1:=ActiveSheet.Cells(Selection.Row, Selection.Column), order1:=xlAscending 'xlAscending (昇順に並び替える)
'xlDescending (降順に並び替える)
End Sub
-------------------------------------------------------------------------
Sub 選択範囲ソート降順()
'あらかじめ範囲を選択する
'参考サイト ttp://excelvba.pc-users.net/fol7/7_4.html
'昇順で並べ替え「A~Z」、数値の場合は「0~9」
'降順で並べ替え「Z~A」、数値の場合は「9~0」
'------------------------------
'アクティブシートの選択範囲をソート(ソートキーを左上)
ActiveSheet.Range(Selection.Address).Sort Key1:=ActiveSheet.Cells(Selection.Row, Selection.Column), order1:=xlDescending 'xlAscending (昇順に並び替える)
'xlDescending (降順に並び替える)
End Sub
Sub 選択範囲ソート昇順()
'あらかじめ範囲を選択する
'参考サイト ttp://excelvba.pc-users.net/fol7/7_4.html
'昇順で並べ替え「A~Z」、数値の場合は「0~9」
'降順で並べ替え「Z~A」、数値の場合は「9~0」
'------------------------------
'アクティブシートの選択範囲をソート(ソートキーを左上)
ActiveSheet.Range(Selection.Address).Sort Key1:=ActiveSheet.Cells(Selection.Row, Selection.Column), order1:=xlAscending 'xlAscending (昇順に並び替える)
'xlDescending (降順に並び替える)
End Sub
Excel2000VBA 罫線の表示、非表示 [Excel2000 VBA独習]
Excel2000VBA 罫線の表示、非表示
Sub 罫線表示非表示()
If ActiveWindow.DisplayGridlines = True Then ActiveWindow.DisplayGridlines = False Else ActiveWindow.DisplayGridlines = True
End Sub
Excel2000VBA 郵便番号を展開して配列に入れる [Excel2000 VBA独習]
Excel2000VBA 郵便番号を展開して配列に入れる
ヤマトの送り状印刷の時に利用する為、郵便番号を分解して1文字づつ取り出す事にした。
Sub 郵便番号を展開して配列に入れる()
'実験
'
Dim postN(8) As String
Dim postNumber As String
Dim i As Integer
'選択している郵便番号を変数postnumberに代入
postNumber = Selection.Value
'郵便番号を左から一文字づつ取り出し配列に入れる
For i = 1 To 8
postN(i) = Mid(postNumber, i, 1) 'Mid(文字列、左からの位置、取り出す文字数)
Next
'結果表示
For i = 1 To 8
Cells(i, "A") = postN(i)
Next
End Sub
Excel2000VBA 選択セルの値が同列に重複が有るか調べる [Excel2000 VBA独習]
Excel2000VBA 選択セルの値が同列に重複が有るか調べる。
ヤフオクで取引連絡の時、「はじめまして」と挨拶を書いてしまうのですが、実際2回目の取引だった事が何回か有り、取引相手様に失礼かも知れないので過去に取引が有ったか調べるマクロ作った。
項目のID(取引相手のID)を利用してH列から重複を調べるマクロ(選択列)
Sub 列内で重複個数を調べる()
'選択しているセルの値と同じものが列全体に何個あるか調べる
'
Dim mykey As String '調べる値
Dim myCol As Long '調べる範囲(列番号)
Dim xRange As Range
Dim counter As Integer 'カウンター
Dim selCol As Range
'選択しているセルの値をmykeyに代入
mykey = Selection.Value
'調べる列、選択しているセルの列
myCol = Selection.Column
'列全体を選択
Columns(myCol).Select
Set selCol = Selection
'選択列から同じ値があるか調べ、個数を表示する
For Each xRange In selCol
If xRange.Value = mykey Then
counter = counter + 1 '
xRange.Interior.ColorIndex = 6 '該当するセルに背景色を付ける
End If
Next
'重複が有ったか?
If counter - 1 = 0 Then
MsgBox mykey & "の重複は有りません"
Else: MsgBox mykey & " は" & counter & "個有りました"
End If
Set selCol = Nothing
End Sub
Excel2000 VBA 全角、半角が混在する郵便番号を半角にする。 [Excel2000 VBA独習]
Excel2000 VBA 全角、半角が混在する郵便番号を半角にする。
コピペで入力した郵便番号を半角に統一したい時に簡単便利なVBA(ASC関数使用)
(ハイフンは記入されているものとする)
Sub 郵便番号半角()
’事前に範囲指定する
Selection.Value = Application.Asc(Selection)
End Sub
参考にしたサイト
ttp://moug.net/tech/exvba/0140046.html