エクセルマクロオンライン講座 質問と回答

  • このエントリーをはてなブックマークに追加

無料・有料のオンライン講座で 寄せられたメッセージの一部を紹介致します。

[7585] 発展編1 フォローメールセミナー 第30回

受講生さんからの投稿です。


こんにちは小川先生。
今迄講座を受け得た知識で過去に作ったマクロがあります。
今回、WorksheetFunctionを勉強させてもらったので、変更してWorksheetFunction.VLookupを取り込んでみようとしました。
しかしマクロを実行すると、VLookupで参照するシートには内容変更が起こらないようにシートの保護をしてあります。
シート保護をしてある状態でもWorksheetFunctionで保護の解除を求められない方法はありますか?
下記のようなマクロでシートの保護はWorksheets("shaban")にかかっています。

Sub VL()
Dim c As Integer
Dim e As Integer
Dim s1 As Worksheet
Dim i As String

e = Range("C65536").End(xlUp).Row
Set s1 = Worksheets("aaa")

' シートを保護していると使えない?
' シート保護を解除するマクロが必要?

For c = 6 To e

' Worksheets("shaban").Unprotect ←このようにしてみたが結局パスワードを求められる…

i = s1.Range("C" & c).Value
s1.Range("D" & c).Value = Application.WorksheetFunction.VLookup(i, Worksheets("shaban").Range("A2").CurrentRegion, 2, False)

' Worksheets("shaban").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True ←よくわからない

Next
End Sub



ご教授お願い致します。
また、発展編1を受講中ですがもう一度復習したのち次のステップに進もうと思ってます。
時間を作りながら勉強している状態でペースは遅いのですが次はどの講義を受講するのが良い手段ですか?
よろしくお願いします。

[ 続きを読む]  返信件数:2件  [ 動画を見る] 

[7542] 発展編1 フォローメールセミナー 第11回

受講生さんからの投稿です。

小川先生、いつもお世話になっております。
印刷範囲とヘッダーを追加した伝票作成マクロの作成を致しました。

モジュールレベルの変数とプロシージャレベルの変数をうまく使い分けることがまだ難しいように感じました。
添削の程、何卒よろしくお願いします。


Option Explicit
Dim Mn As Worksheet
Dim Mn1 As Worksheet
Dim Amax As Long

Sub Denpyo_making()
Set Mn = Worksheets("main")
Set Mn1 = Worksheets("main1")
Amax = Mn.Range("B65536").End(xlUp).Row

Deletesheets1
Numbering
Narabikae
sheets_making
Narabikae2
syuseiH_C

End Sub

Sub Deletesheets1()
Dim Ws As Worksheet
Application.DisplayAlerts = False
For Each Ws In Worksheets
If Left(Ws.Name, 4) <> "main" Then
Ws.Delete
End If
Next
Application.DisplayAlerts = True
End Sub

Sub Numbering()

Mn.Range("A2").Value = 1
Mn.Range("A2").AutoFill _
Mn.Range("A2:A" & Amax), xlFillSeries

End Sub

Sub Narabikae()
Mn.Sort.SortFields.Clear
Mn.Sort.SortFields.Add Key:= _
Range("B1"), Order:=xlAscending
With Mn.Sort
.SetRange Range("A1:G" & Amax)
.Header = xlYes
.Apply
End With
End Sub

Sub sheets_making()
Dim Namae As String
Dim gyo As Long
Dim Nws As Worksheet
Dim dt As Date '日付
Dim saki As Long

For gyo = 2 To Amax
If Namae <> Mn.Range("B" & gyo).Value Then
If gyo > 2 Then
keisen_making '最初だけ罫線回避
End If
Namae = Mn.Range("B" & gyo).Value
Sheets("main1").Copy After:=Sheets(Sheets.Count)
Sheets("main1 (2)").Select
Sheets("main1 (2)").Name = Namae
Set Nws = Worksheets(Namae)
saki = 16
End If

dt = Mn.Range("C" & gyo).Value
Nws.Range("B" & saki).Value = Right(Year(dt), 2)
Nws.Range("C" & saki).Value = Month(dt)
Nws.Range("D" & saki).Value = Day(dt)
Nws.Range("F2").Value = Mn.Range("B" & gyo).Value
Nws.Range("E" & saki).Value = Mn.Range("D" & gyo).Value
Nws.Range("F" & saki).Value = Mn.Range("E" & gyo).Value
Nws.Range("H" & saki).Value = Mn.Range("F" & gyo).Value

If Mn.Range("G" & gyo).Value > 0 Then
Nws.Range("I" & saki).Value = Mn.Range("G" & gyo).Value
Else
Nws.Range("J" & saki).Value = Mn.Range("G" & gyo).Value
End If
Nws.Range("K" & saki).Value = Nws.Range("I" & saki).Value + Nws.Range("J" & saki).Value
saki = saki + 1
Next
keisen_making '最後の会社のシートに罫線つける
End Sub

Sub keisen_making()
Dim cNewmax
cNewmax = Range("B65536").End(xlUp).Row
Range("B16:K" & cNewmax).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
End Sub

Sub Narabikae2()
Mn.Sort.SortFields.Clear
Mn.Sort.SortFields.Add Key:= _
Range("C1"), Order:=xlAscending
With Mn.Sort
.SetRange Range("A2:G" & Amax)
.Header = xlYes
.Apply
End With
Mn.Range("A2").Value = ""
Mn.Range("A2").AutoFill _
Mn.Range("A2:A" & Amax), xlFillSeries

End Sub

Sub syuseiH_C()
Dim cNewmax As Long
Dim c As Long
Dim Wh As Worksheet
cNewmax = Range("B65536").End(xlUp).Row

For Each Wh In Worksheets
If Left(Wh.Name, 4) <> "main" Then
With Wh.PageSetup
.LeftHeader = Wh.Name
.RightHeader = "&D"
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = False
End With
ActiveSheet.PageSetup.PrintArea = "A1:K" & cNewmax
End If
Next
End Sub

[ 続きを読む]  返信件数:1件  [ 動画を見る] 

[7355] 発展編1 フォローメールセミナー 第23回

平吹 敦史さんからの投稿です。

お世話になります。
Formulaプロパティは、最初違いがよくわかりませんでしたが、簡単なテストをして、よくわかりました。今までは、数式はExcelで事前につくっておいて、それ以外をvbaで処理していました。
数式そのものもvbaで処理できることがわかり、幅が広がりそうです。

[ 続きを読む]  返信件数:1件  [ 動画を見る] 

[7323] 発展編1 フォローメールセミナー 第11回

受講生さんからの投稿です。

小川先生
お世話になっております。
10月末から勉強させていただいております。
複数シート間で処理をするときのプログラムの書き方がまだしっかりと身についていません。
また変数名を何にするか決めるのに時間がかかり決めた変数名に自信が持てません。
引き続き身につくよう勉強していきます。
読みにくいコードとなり申し訳ありませんがご確認お願いいたします。

Sub denpyoMake()
'mainシートの取引先名称ごとにシートを分ける

Dim shFm As Worksheet
Dim shTo As Worksheet
Dim sortMaeNum As Long
Dim sortMaeNumMx
Dim lnfm As Long
Dim lnfmMx As Long
Dim lnTo As Long
Dim dt As Date

Set shFm = Worksheets("main")

'main、main1以外のシートを削除
deleteSheet

sortMaeNumMx = Range("B" & Rows.Count).End(xlUp).Row
For sortMaeNum = 2 To sortMaeNumMx
shFm.Range("A" & sortMaeNum).Value = sortMaeNum - 1
Next sortMaeNum

'mainシートでソートする
sortTorihiki

lnfmMx = Range("B" & Rows.Count).End(xlUp).Row
For lnfm = 2 To lnfmMx
If shFm.Range("B" & lnfm).Value <> shFm.Range("B" & lnfm - 1).Value Then
If lnfm <> 2 Then
'罫線を引く
keisenDraw (lnTo)

'印刷範囲を設定する
printSetting (lnTo)
End If

Worksheets("main1").Copy after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = shFm.Range("B" & lnfm).Value
Set shTo = ActiveSheet
shTo.Range("F2").Value = shTo.Name
lnTo = 16
Else
lnTo = lnTo + 1
End If
dt = shFm.Range("C" & lnfm).Value
shTo.Range("B" & lnTo).Value = Right(Year(dt), 2)
shTo.Range("C" & lnTo).Value = Month(dt)
shTo.Range("D" & lnTo).Value = Day(dt)
shTo.Range("E" & lnTo).Value = shFm.Range("D" & lnfm).Value
shTo.Range("F" & lnTo).Value = shFm.Range("E" & lnfm).Value
shTo.Range("H" & lnTo).Value = shFm.Range("F" & lnfm).Value
If shFm.Range("G" & lnfm).Value > 0 Then
shTo.Range("I" & lnTo).Value = shFm.Range("G" & lnfm).Value
Else
shTo.Range("J" & lnTo).Value = shFm.Range("G" & lnfm).Value
End If
shTo.Range("K" & lnTo).Value = shTo.Range("K" & lnTo - 1).Value + shFm.Range("G" & lnfm).Value

Next lnfm

'mainシートを元の順番でソートする
sortMotojun

shFm.Activate
shFm.Range("A1").Select

End Sub

Private Sub sortTorihiki()
'取引先名称で並び替える

Columns("A:G").Select
With Worksheets("main").Sort
.SortFields.Clear
.SortFields.Add Key:=Range("B:B"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SortFields.Add Key:=Range("C:C"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SortFields.Add Key:=Range("D:D"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SortFields.Add Key:=Range("E:E"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SortFields.Add Key:=Range("F:F"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

.SetRange Range("A:G")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Worksheets("main").Range("A1").Value = "No"
End Sub

Private Sub sortMotojun()
'元の並び順に並び替える

Columns("A:G").Select
With Worksheets("main").Sort
.SortFields.Clear
.SortFields.Add Key:=Range("A:A"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

.SetRange Range("A:G")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A:A").ClearContents
End Sub

Private Sub deleteSheet()
' main、main1以外のシートを削除する

Application.DisplayAlerts = False
Dim sh As Worksheet
For Each sh In Worksheets
If Left(sh.Name, 4) <> "main" Then
sh.Delete
End If
Next
Application.DisplayAlerts = True
End Sub

Private Sub keisenDraw(mxGyo As Long)
'追加シートに罫線を引く

With Range("B16:K" & mxGyo)
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
End With
End Sub

Private Sub printSetting(maxGyo As Long)
'印刷範囲を変更する。またヘッダ・フッタを入れる。

Range("A1:L" & maxGyo).Select
ActiveSheet.PageSetup.PrintArea = "A1:L" & maxGyo + 1
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = "&D"
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = "&A"
.LeftMargin = Application.InchesToPoints(0.78740157480315)
.RightMargin = Application.InchesToPoints(0.78740157480315)
.TopMargin = Application.InchesToPoints(0.984251968503937)
.BottomMargin = Application.InchesToPoints(0.984251968503937)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0.511811023622047)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.CenterHorizontally = True
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 10
.FitToPagesTall = 10
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = False
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
Application.PrintCommunication = True
End Sub

[ 続きを読む]  返信件数:1件  [ 動画を見る] 

[5661] 発展編1 フォローメールセミナー 第11回

受講生さんからの投稿です。

小川先生、いつもお世話になっております。
追加要件の宿題を提出いたします。前回の宿題提出時に頂いたご指導のお陰で、ループの初回の罫線設定回避策もよく理解出来て、スラスラと書けるようになりました。
今回はオートフィルでA列に番号を振る別解としました。オートフィルのハンドル部分をダブルクリックするだけで、表がある部分全てにオートフィルが実行されることは知らなかったので、
また新たな学びが出来ました。(今更というカンジですが…(;・∀・))添削ご指導よろしくお願いいたします。

Sub creatDenpyo()
deleteDenpyo

Dim wFm As Worksheet
Set wFm = Worksheets("main")
Dim wTmp As Worksheet
Set wTmp = Worksheets("main1")
Dim wTo As Worksheet

'(1)A列に番号を振る(オートフィルで)
wFm.Range("A2").FormulaR1C1 = "1"
wFm.Range("A3").FormulaR1C1 = "2"
wFm.Range("A2:A3").AutoFill Destination:=wFm.Range("A2:A317")

'(2)B列でソート
wFm.Range("A1:G317").Sort Key1:=wFm.Range("B1"), Order1:=xlAscending, Header:=xlYes

'(3)伝票テンプレートにヘッダー/フッター挿入、印刷範囲設定クリア
With wTmp.PageSetup
.CenterHeader = "&A"
.CenterFooter = "&P / &N ページ"
.PrintArea = ""
End With

'(4)伝票作成
Dim gyo As Long
Dim gyoMax As Long
gyoMax = wFm.Range("B" & Rows.Count).End(xlUp).Row
Dim gyoTo As Long
gyoTo = 16
For gyo = 2 To gyoMax
If wFm.Range("B" & gyo).Value <> wFm.Range("B" & gyo - 1).Value Then
If gyo > 2 Then
keisen
End If
gyoTo = 16
wTmp.Copy After:=Sheets(2)
Set wTo = ActiveSheet
wTo.Name = wFm.Range("B" & gyo).Value
End If
wTo.Range("B" & gyoTo) = Mid(Year(wFm.Range("C" & gyo).Value), 3)
wTo.Range("C" & gyoTo) = Month(wFm.Range("C" & gyo).Value)
wTo.Range("D" & gyoTo) = Day(wFm.Range("C" & gyo).Value)
wTo.Range("E" & gyoTo) = wFm.Range("D" & gyo).Value
wTo.Range("F" & gyoTo) = wFm.Range("E" & gyo).Value
wTo.Range("H" & gyoTo) = wFm.Range("F" & gyo).Value
If wFm.Range("G" & gyo).Value > 0 Then
wTo.Range("I" & gyoTo) = wFm.Range("G" & gyo).Value
Else
wTo.Range("J" & gyoTo) = wFm.Range("G" & gyo).Value
End If
If gyoTo > 16 Then
wTo.Range("K" & gyoTo) = wTo.Range("I" & gyoTo).Value + wTo.Range("J" & gyoTo).Value + wTo.Range("K" & gyoTo - 1).Value
Else
wTo.Range("K" & gyoTo) = wTo.Range("I" & gyoTo).Value + wTo.Range("J" & gyoTo).Value
End If
gyoTo = gyoTo + 1
Next
keisen

'(5)A列でソート
wFm.Range("A1:G317").Sort Key1:=wFm.Range("A1"), Order1:=xlAscending, Header:=xlYes

'(6)A列の値消去
wFm.Range("A1:A317").ClearContents
End Sub

Sub deleteDenpyo()
Dim ws As Worksheet
Application.DisplayAlerts = False
For Each ws In Worksheets
If ws.Name <> "main1" And ws.Name <> "main" Then
ws.Delete
End If
Next
Application.DisplayAlerts = True
End Sub

Sub keisen()
Dim gyoMax
gyoMax = Range("B" & Rows.Count).End(xlUp).Row

With Range("B16", "K" & gyoMax)
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlHairline
End With
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlHairline
End With
End With
End Sub


[ 続きを読む]  返信件数:1件  [ 動画を見る] 

[5633] 発展編1 フォローメールセミナー 第9回

受講生さんからの投稿です。

小川先生、いつも大変お世話になっております。

昨年12月から受講開始した発展編の視聴が一通り終了しましたので、
年明けからフォローアップメールセミナーの伝票作成マクロに取り掛かってきました。
発展編での学びを定着させるのにとても勉強になっております。
実務の方でも非常に役に立っており、大変感謝致しております。

この伝票作成マクロの動画を通じて、withブロックの中身を置換でシンプルに修正する方法が
大変参考になりました。
またテスト時のブレークポイントの設定についても良い復習となり、
実務の方で活かしていきたいと実感しました。

以下に宿題を投稿させて頂きます。
先生の動画を視聴した直後に作成しましたので、殆ど先生のコードと違わないとは思いますが、
いざ自分で作ってみるとなると、罫線を引くタイミングが難しくて、
特にmainシートに罫線が引かれてしまう時の回避策がどうしても思いつかず、
単純に、”シート名がmainでなければ”、という表現となってしまいましたが・・・(・∀・;)
よろしくお願いいたします。



Sub deleteDenpyo()
Dim ws As Worksheet
Application.DisplayAlerts = False
For Each ws In Worksheets
If ws.Name <> "main" And ws.Name <> "main1" Then
ws.Delete
End If
Next
Application.DisplayAlerts = True
End Sub

Sub createDenpyo()
deleteDenpyo

Dim wFm As Worksheet
Dim wTo As Worksheet
Set wFm = Worksheets("main")

'日付の昇順に番号振る
Dim gyoMax As Long
gyoMax = wFm.Range("B" & Rows.Count).End(xlUp).Row
Dim gyo As Long
For gyo = 2 To gyoMax
wFm.Range("A" & gyo).Value = gyo - 1
Next

'B列ソート
wFm.Range("A2:G317").Sort Key1:=wFm.Range("B1"), Order1:=xlAscending, Header:=xlYes

'伝票作成
Dim gyoTo As Long
For gyo = 2 To gyoMax
'取引先名称が違えばシートを作る
If wFm.Range("B" & gyo).Value <> wFm.Range("B" & gyo - 1).Value Then
If ActiveSheet.Name <> "main" Then
keisen
End If
Sheets("main1").Copy After:=Sheets(2)
Set wTo = Sheets("main1 (2)")
wTo.Name = wFm.Range("B" & gyo).Value
gyoTo = 16
End If
'シートを作成後、データを投入していく
wTo.Range("B" & gyoTo).Value = Mid(Year(wFm.Range("C" & gyo).Value), 3)
wTo.Range("C" & gyoTo).Value = Month(wFm.Range("C" & gyo).Value)
wTo.Range("D" & gyoTo).Value = Day(wFm.Range("C" & gyo).Value)

wTo.Range("E" & gyoTo).Value = wFm.Range("D" & gyo).Value
wTo.Range("F" & gyoTo).Value = wFm.Range("E" & gyo).Value
wTo.Range("H" & gyoTo).Value = wFm.Range("F" & gyo).Value
If wFm.Range("G" & gyo).Value > 0 Then
wTo.Range("I" & gyoTo).Value = wFm.Range("G" & gyo).Value
Else
wTo.Range("J" & gyoTo).Value = wFm.Range("G" & gyo).Value
End If
If gyoTo = 16 Then
wTo.Range("K" & gyoTo).Value = wTo.Range("I" & gyoTo).Value + wTo.Range("J" & gyoTo).Value
Else
wTo.Range("K" & gyoTo).Value = wTo.Range("K" & gyoTo - 1).Value + wTo.Range("I" & gyoTo).Value + wTo.Range("J" & gyoTo).Value
End If
gyoTo = gyoTo + 1
Next
keisen
End Sub

Sub keisen()
Dim gyoToMax
gyoToMax = Range("B" & Rows.Count).End(xlUp).Row
Range("B16:K" & gyoToMax).Select

With Range("B16:K" & gyoToMax)
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlHairline
End With
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlHairline
End With

End With

End Sub



[ 続きを読む]  返信件数:5件  [ 動画を見る] 

[5543] 発展編1 フォローメールセミナー 第12回

山田 将之さんからの投稿です。

必ずこれをするようにします。ありがとうございました。

[ 続きを読む]  返信件数:1件  [ 動画を見る] 

[5097] 発展編1 フォローメールセミナー 第14回

虫谷吉男さんからの投稿です。

WEBのデータは一度テキストエディタに落としてからエクセルに貼り付けるとスムーズなんですね。
知り得てよかったです。そのままエクセルにベタ貼りするのと全然違いました。

[ 続きを読む]  返信件数:1件  [ 動画を見る] 

[4984] 発展編1 フォローメールセミナー 第29回

森 則彦さんからの投稿です。

小川先生、お世話になっております。発展編フォローセミナーNo.29のカレンダー問題がようやく自分なりの解釈で何とか出来ました。
予習の意味で新しい構文を使ってみました。作り込む最中で色々なアイデアを試しながら出来、再発見、再確認ができました。
今回はいかに効率よく走るかを私なりに考えてつくりました。先生のご感想よろしくお願いします。先生のNO.29のメールからダウンロードしたファイルの中に、ControlのシートがなかったのでNO.26のファイルを使用して、祭日には、文字を赤、背景を黄色とする、前提条件としました。後で思ったのですが、
Summaryのシートにデータを入れるタイミングは1か月分が出来上がった段階で一気にそれをコピーした方がスピードが速いのではないかなと思いました。プログラムは出来上がりは同じでも課程はいろいろある所がじつに面白いですね。もっといろいろな構文、アルゴリズムを勉強すればさらにプログラミングの世界が広がる思うと、今後がたのしみです。上級編もまた、お願いしたいと思います。では、先生の感想をお待ちしております。
追伸。2015年のカレンダーにしました。

code

Dim dStart As Date, wNa As Integer
Dim list(6, 2) As Variant, sAijitu(16, 2) As Variant

Private Sub CalenCre()
CreMSht
dStart = #1/1/2015#
Dim mCnt As Long
Dim cOnws As Worksheet
Dim c As Integer
Set cOnws = Worksheets("Control")
With cOnws.Range("a2")
For c = 0 To 6
list(c, 0) = c + 1
list(c, 1) = .Offset(c).Interior.ColorIndex
list(c, 2) = .Offset(c).Font.ColorIndex
Next
End With
With cOnws.Range("c2")
For c = 0 To 16
sAijitu(c, 0) = .Offset(c).Value
sAijitu(c, 1) = .Offset(c).Interior.ColorIndex
sAijitu(c, 2) = .Offset(c).Font.ColorIndex
Next
End With
Worksheets("Summary").Copy after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = "dami"
For mCnt = 1 To 12
Worksheets("dami").Copy after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = mCnt & "月"
calen_exe
dStart = DateAdd("m", 1, dStart)
Next
Application.DisplayAlerts = False
Worksheets("dami").Delete
Application.DisplayAlerts = True
Worksheets("Summary").Activate
End Sub

Public Sub calen_exe()
Dim dCnt As Date, sAicnt As Integer, mEmo
Dim c As Long, cYoko As Long, mAx As Long, yOucnt As Integer
Dim jyuS As String
Dim sH As Worksheet
Set sH = Worksheets("Summary")
Dim rg As Range
mAx = sH.Range("a" & Rows.Count).End(xlUp).Row
Set rg = sH.Range("a" & mAx + 1)
dCnt = dStart
c = 0
With Range("a2")
Do While Month(dCnt) = Month(dStart)
.Offset(c, 0).Value = dCnt
wNa = Weekday(dCnt)
.Offset(c, 1).Value = WeekdayName(wNa)
.Offset(c, 2).Value = #9:00:00 AM#
.Offset(c, 3).Value = #5:00:00 PM#
jyuS = "=" & .Offset(c, 3) & "-" & .Offset(c, 2).Value
.Offset(c, 4).Formula = jyuS
For cYoko = 0 To 4
rg.Offset(c, cYoko).Formula = "='" & .Worksheet.Name & "'!" & .Offset(c, cYoko).Address
Next
For sAicnt = mEmo To 16
If dCnt = sAijitu(sAicnt, 0) Then
With Range(rg.Offset(c, 0), rg.Offset(c, 4))
.Interior.ColorIndex = sAijitu(sAicnt, 1)
.Font.ColorIndex = sAijitu(sAicnt, 2)
End With
With Range(.Offset(c, 0), .Offset(c, 4))
.Interior.ColorIndex = sAijitu(sAicnt, 1)
.Font.ColorIndex = sAijitu(sAicnt, 2)
End With
mEmo = mEmo + 1
GoTo line1
End If
Next
For yOucnt = 0 To 6
If wNa = list(yOucnt, 0) Then
With Range(rg.Offset(c, 0), rg.Offset(c, 4))
.Interior.ColorIndex = list(yOucnt, 1)
.Font.ColorIndex = list(yOucnt, 2)
End With
With Range(.Offset(c, 0), .Offset(c, 4))
.Interior.ColorIndex = list(yOucnt, 1)
.Font.ColorIndex = list(yOucnt, 2)
End With
GoTo line1
End If
Next
line1:
dCnt = DateAdd("d", 1, dCnt)
c = c + 1
Loop
End With
End Sub

Public Sub CreMSht()
Dim wS As Worksheet
Dim orWs As Worksheet, nEwws As Worksheet, orCws As Worksheet
Set orWs = Worksheets("Summary")
Set orCws = Worksheets("Control")
Application.DisplayAlerts = False
For Each wS In Worksheets
If Not (wS Is orWs Or wS Is orCws) Then
wS.Delete
End If
Next
Application.DisplayAlerts = True
clean
End Sub

Public Sub clean()
Worksheets("Summary").Activate
Dim gyo As Long
gyo = Range("a" & Rows.Count).End(xlUp).Row
If gyo > 1 Then
With Range("a2", "e" & gyo)
.ClearContents
.Interior.ColorIndex = xlNone
.Font.ColorIndex = 0
End With
End If
End Sub

/code

[ 続きを読む]  返信件数:1件  [ 動画を見る] 

[4908] 発展編1 フォローメールセミナー 第9回

森 則彦さんからの投稿です。

小川先生、お世話になっております。
ちょっと時間はかかりましたが何とか出来ました。

コレクションの概念をたえず意識しながら、自分なりにNETや、本などで勉強しつつ、
先生の考え方を参考にして、違った表現で書いてみました

最初よりは、やりたいことが何となくスラスラとイメージ出来る様になった気がします。
また、他の人が書いたプログラムも読める様になったと思います。

先生から見ればまだまだ知らない初心者でレベルの低い話ではあると思いますが、
他の人の書いたものも参考にしつつスラスラと出来る様になると、遥かかなたのVBAの達人。
頂上に向かって登っているときは楽し~いものですね。何歳になっても。

以下が練習問題の私の今の力の回答です。感想よろしくお願いします。


code
Sub ren212()
DeleteSheets

Dim fmWs As Worksheet, toWs As Worksheet, orWs As Worksheet
Dim rG As Range, aLrg As Range, keiSen As Range
Dim kaiSya As String
Dim mX As Long, toCnt As Long, kEi As Long, kGaku As Long
Set fmWs = Worksheets("main1")
Set orWs = Worksheets("main")
orWs.Range("b1").Sort key1:=Range("b1"), order1:=xlAscending, Header:=xlYes
mX = Range("b" & Rows.Count).End(xlUp).Row
Set aLrg = orWs.Range("b2", "b" & mX)
For Each rG In aLrg
If Not kaiSya = rG Then
If Not kaiSya = "" Then
Set keiSen = Worksheets(kaiSya).Range("b16", "k" & 15 + toCnt)
keiSen.Borders.LineStyle = xlContinuous
End If
fmWs.Copy after:=Worksheets(Worksheets.Count)
Set toWs = ActiveSheet
kaiSya = rG.Value
toWs.Name = kaiSya
kEi = 0
toCnt = 0
End If
With toWs.Range("b16")
.Offset(toCnt, 0).Value = Right(Year(rG.Offset(, 1).Value), 2)
.Offset(toCnt, 1).Value = Month(rG.Offset(, 1).Value)
.Offset(toCnt, 2).Value = Day(rG.Offset(, 1).Value)
.Offset(toCnt, 3).Value = rG.Offset(, 2).Value
.Offset(toCnt, 4).Value = rG.Offset(, 3).Value
.Offset(toCnt, 6).Value = rG.Offset(, 4).Value
kGaku = rG.Offset(, 5).Value
If kGaku >= 0 Then
.Offset(toCnt, 7).Value = kGaku
Else
.Offset(toCnt, 8).Value = kGaku
End If
kEi = kEi + kGaku
.Offset(toCnt, 9).Value = kEi
End With
toCnt = toCnt + 1
Next
Set keiSen = Worksheets(kaiSya).Range("b16", "k" & 15 + toCnt)
keiSen.Borders.LineStyle = xlContinuous
orWs.Activate
orWs.Range("a1").Sort key1:=Range("a1"), order1:=xlAscending, Header:=xlYes
End Sub


Sub DeleteSheets()
Dim ws As Worksheet
Application.DisplayAlerts = False
For Each ws In Worksheets
If Not ws.Name Like "main*" Then
ws.Delete
End If
Next
Application.DisplayAlerts = True
End Sub
/code

[ 続きを読む]  返信件数:1件  [ 動画を見る] 

[4887] 発展編1 フォローメールセミナー 第9回

受講生さんからの投稿です。

小川先生

ようやく宿題ができました。まる一日かかってしまいましたが、なんとか動きました。よろしくお願いいたします。
From  岡田 まさこ


option explicit
Sub denpyo_sakusei_homework()
denpyo_sakujo
narabekae
sheetsakusei
End Sub

'以下はそれぞれの部品です。

Sub denpyo_sakujo() '部品1
Dim ws As Worksheet

Application.DisplayAlerts = False

For Each ws In Worksheets
If Left(ws.Name, 4) <> "main" Then
ws.Delete
End If
Next
Application.DisplayAlerts = True

End Sub

Sub narabekae() '部品2
Dim wfm As Worksheet
Set wfm = Worksheets("main")

wfm.Range("A2").FormulaR1C1 = "1"
wfm.Range("A3").FormulaR1C1 = "2"
wfm.Range("A4").FormulaR1C1 = "3"
wfm.Range("A2:A4").AutoFill Destination:=Range("A2:A317")

wfm.Sort.SortFields.Clear
wfm.Sort.SortFields.Add Key:=Range("B2:B317"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With wfm.Sort
.SetRange Range("A1:G317")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With



End Sub

Sub sheetsakusei() '部品3
Dim wfm As Worksheet
Dim wto As Worksheet
Dim cfm As Long
Dim mx As Long
Dim cto As Long

Set wfm = Worksheets("main")
Set wto = Worksheets("main1")
mx = Range("B" & Rows.Count).End(xlUp).Row

For cfm = 2 To mx

If wfm.Range("B" & cfm).Value <> wfm.Range("B" & cfm - 1).Value Then
If cfm > 2 Then
keisen
End If

Worksheets("main1").Copy After:=Worksheets(Worksheets.Count)
Set wto = ActiveSheet
wto.Name = wfm.Range("B" & cfm).Value
cto = 16
End If

If wto.Name = wfm.Range("B" & cfm).Value Then
wto.Range("E" & cto).Value = wfm.Range("D" & cfm).Value
wto.Range("F" & cto).Value = wfm.Range("E" & cfm).Value
wto.Range("H" & cto).Value = wfm.Range("F" & cfm).Value
wto.Range("J12").Value = wfm.Range("B" & cfm).Value

wto.Range("B" & cto).Value = Right(Year(wfm.Range("C" & cfm).Value), 2)
wto.Range("C" & cto).Value = Month(wfm.Range("C" & cfm).Value)
wto.Range("D" & cto).Value = Day(wfm.Range("C" & cfm).Value)

If wfm.Range("G" & cfm).Value > 0 Then
wto.Range("I" & cto).Value = wfm.Range("G" & cfm).Value
Else
wto.Range("J" & cto).Value = wfm.Range("G" & cfm).Value
End If



Dim c As Range
Set c = wto.Range("K" & cto)
If cto = 16 Then
c = c.Offset(0, -2).Value + c.Offset(0, -1).Value
Else
c = c.Offset(-1, 0).Value + c.Offset(0, -2).Value + c.Offset(0, -1).Value
End If
cto = cto + 1
End If

Next
keisen

Worksheets("main").Activate


wfm.Sort.SortFields.Clear
wfm.Sort.SortFields.Add Key:=Range("A1"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With wfm.Sort
.SetRange Range("A1:G317")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

Columns("A:A").ClearContents

End Sub

Sub keisen() '部品4
Dim kmx As Long
kmx = Range("K" & Rows.Count).End(xlUp).Row

With Range("B16:K" & kmx + 1)
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone

With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
End With


End Sub


[ 続きを読む]  返信件数:3件  [ 動画を見る] 

[4716] 発展編1 フォローメールセミナー 第1回

唐沢俊孝さんからの投稿です。

昨日は、会社の実務で発展編Ⅰで学んだマクロを活かし、時短に大きく貢献できました!かなり嬉しいです。

新規依頼で必ず作業記録をA4:1枚で作成しなければならないのですが、今回は記録用紙に写真や図が多々貼り付けられており、
記録の内容が多いため、表裏の両面印刷で200枚作成しなければならない作業でした。

記録(表裏)各々管理番号を入力する箇所があり、4桁のアルファベットと3桁の数字を入力する必要がありました。
グループ員が取り組み始めていましたが、作成方法を試しに聞いてみたら、
エクセルファイルを400シート(2シート(表用と裏用)×200枚分)作成し印刷する・・・ と言っていました(汗)
①図や写真が張り付いている分、容量が大きくなり途中でフリーズ、②管理番号の打ち間違えによるミス、
③マウス使って操作しているのでかなり時間がかかる など一瞬で暗雲が漂ってきました。
 →このままやらせたら相当な残業の割に成果もでないと思いましたので、自分がこれを受け持ちました。 

エクセルシートは計3シート【2シート(表/裏)+管理番号リスト用1シート】のみで、マクロはハナコのステップで仕上げました。
(1)For Each構文で管理番号リストシートのrange範囲(最終行変動バージョン)を指定
(2)表と裏のシートの管理番号入力欄に管理番号を入力することを指定
(3)2シートを両面印刷する内容を自動記録を利用で指示語修正
(1)~(3)約7分+試し刷り5分で動作確認完了。
後は200枚実行し、印刷時間で約1.5時間でした。
もし発展編を習っていなければ、こんなに速く終わらなかったと思います!

1点質問があります。
図や写真(jpegファイル等)をエクセルシートに貼り付ける等のマクロは自動記録で確認することができないのでしょうか。

別作業で写真8枚をサイズ変更等してエクセル1シートの定位置に各々貼り付けて行く作業がありました。
これもマクロでできそうだと思い、自動記録で写真を挿入、定位置移動、サイズ変更を自動記録でしてみましたが、
セルのselectしか記載されませんでした。何度か試しましたが結果は同じで、その自動記録マクロを実行しても、
セルが指定されるだけでした。マウスを使った操作でもやってみましたが、同じ結果でした。
図や写真はshapesのコレクションで少し触れていましたが、動画説明でもそこまで詳しい内容がありませんでした。
写真挿入は自動記録でマクロが確認できないのでしょうか。

[ 続きを読む]  返信件数:10件  [ 動画を見る] 

[4583] 発展編1 フォローメールセミナー 第1回

唐沢俊孝さんからの投稿です。

発展編Ⅰのフォローアップメールありがとうございます。
朝の体操、伝票作成、mini問題が3日分届いていますが、
発展編1動画を全部理解しないとこれらの問題は現状書けないものが出てきています。
(動画はまだ1章の途中です。いきなりfor each構文の話が出ていたり???、
 頭の体操メールも3日目(6/25)のはファイルを開く、保存するなど初めてのものだらけで少々消化するのに
 時間がかかりそうです(^^;
ショートカット等にもウェイトを置きたいので、この内容を3ヶ月で消化できるかな(^^;

1.以下アドバイスお願いします。
伝票作成s01の以下の問題を解いてみました。
>[2]
>「そんなの簡単だよ!」ということでしたら、
>さらに、元データが何行になってもマクロを
>書き換えなくても済むよう、ForNextのカウンターが
>終わる条件を変数を使って決定できるようにも
>してみてください。

最終行を選択する方法をRange("B" & Rows.Count).End(xlUp).Rowと表現しました。
エクセルのパージョンにより、max行数が変わると思いましたので、rows.countを使いました。
きちんと動くのを確認しました。
Sub torihikisakiend2()
Dim cgyo As Long
For cgyo = 2 To Range("B" & Rows.Count).End(xlUp).Row 'rangeでの最終行の書き方!
Debug.Print Worksheets("main").Range("B" & cgyo)
Next cgyo
End Sub

2.メール(頭の体操)3日目の問題ですが、解らないところがありますので、教えてください。

問題[1]
今開いているファイルと同じフォルダにあるエクセルファイル「Book2.xls」を開く

●発展編Ⅰ1章の固有オブジェクトの変数を今日学びましたので、それに習って自分で書いてみましたが、
 エラーが起きて上手くいきませんでした。中級編第5章参考とメールにありましたが、5章の何番目の動画が教えてください。
 動画題名を見るとどれにも該当しないような気がします。コードの途中に質問を入れています。

'模範解答
Sub taisou3_1()
Workbooks.Open Filename:=ThisWorkbook.Path & "\book2.xls"  ’¥がファイル名の頭に2文字ありますが、1文字でもできました。
                              ’¥は2個でも1個でもどちらでも良いのでしょうか。
Snd Sub

’自分で書いた間違いマクロ
Sub taisou3_2() 
Dim fairu As Workbook ’開くbookにニックネームをつけました
Set fairu = Workbooks("Book2.xls")  '固有オブジェクトに習って書いてみましたが、ここでデバッグとなり先へ進みません。
                 ’どこが間違ってるか何度見てもわかりませんでした。
                  ’そもそもこの問題で固有オブジェクト変数を使用する必要がないのでしょうか。
Dim stpath As String '保存先のパスを文字列で宣言
stpath = ThisWorkbook.Path ’上で止まるので、ここから下は確認できていません。
Workbooks.Open Filename:=stpath & "\\" & fairu                       
End Sub

[ 続きを読む]  返信件数:1件  [ 動画を見る] 

[4577] 発展編1 フォローメールセミナー 第1回

唐沢俊孝さんからの投稿です。

考えた挙句、やっとたどり着きました。
エクセルのバージョンが変わることでmaxの行数も変わると思いましたので、
それに対応できるように rows.count を使いました。
基礎編を習ったのち、仕事で活かせるよう基礎編をベースにマクロを書き、解らないところはネットで探しました。
ネット上では B列の場合 cells(Rows.Count,2).End(xlUp).Row の表記しか出てきませんでした。
rangeで習った自分には、cellはどうも自分にしっくりこないので、なんとかrangeで表記したく
色々試したら、Range("B" & Rows.Count).End(xlUp).Row でいけました!
見つかって嬉しいです!

Sub torihikisakiend()
Dim cgyo As Long
For cgyo = 2 To Range("B" & Rows.Count).End(xlUp).Row
Debug.Print Worksheets("main").Range("B" & cgyo)
Next cgyo
End Sub

[ 続きを読む]  返信件数:1件  [ 動画を見る] 

[4473] 発展編1 フォローメールセミナー 第24回

山田 将之さんからの投稿です。

ありがとうございます。with構文、offset,do loopの活用の仕方理解できました。
動画を見て復習してすっきりしました。感謝します。

[ 続きを読む]  返信件数:1件  [ 動画を見る] 

[4059] 発展編1 フォローメールセミナー 第1回

watanbe daichiさんからの投稿です。

本編を一通り確認して、メールセミナーへきました。
これから、続けさせていただきます。

[ 続きを読む]  返信件数:1件  [ 動画を見る] 

[3963] 発展編1 フォローメールセミナー 第18回

佐々木久さんからの投稿です。

他のセルで F2 alt + enter を押して、
rvalue_rvalue を実行しても、改行が削除されないのですが
何か方法が間違っているのでしょうか?

佐々木

[ 続きを読む]  返信件数:1件  [ 動画を見る] 

[3931] 発展編1 フォローメールセミナー 第1回

受講生さんからの投稿です。

まだいざ、お題に対してどのようなことを書けばいいか、すぐに答えが出てこない。デバックプリントの使い方も忘れてしまっていた。
復習の必要性を感じました。

[ 続きを読む]  返信件数:1件  [ 動画を見る] 

[3627] 発展編1 フォローメールセミナー 第2回

ゲストさんからの投稿です。

初心者です。

初めてなのでわからないことだらけなのですが、、
少しずつできるようになれるように楽しみながらやっていきたいです。よろしくお願いします。
シートをコピーして、名前をつける、マクロがまだ一人でできない状況です。


以下だと、何が問題なのか自分では解明できなくて、教えていただきたいのですが。

①active sheetsのままがいけませんか。
②まだ、はなこのステップのはこのどこに、どこまでのお団子をいれたらいいか、よくわかっていません。また、変数を定義する場所もよくわかっていません。

アドバイスをいただけると幸いです。よろしくお願いします。  (渡辺早紀)



'シート「main」にある各取引先の名称のシートを作れ
'(シートには何も記載されていなくてよい)
'ヒント: [1] シートを追加するマクロを作ってみる
' [2] [1]で作ったマクロで、さらに、その直後に、作ったシートの名前を変更するようにする
' [3] [2]で作ったマクロで、作ったシートの名前を、シート「main」のセルB2の値になるようにする
' [4] [3]で作ったマクロで、シート「main」の2行目から21行目までで連続作業をするよう改変する

------------------------------------

Sub shadd()

Dim gyo 'エラーメッセージが、「この名前は既に使用されています。別の名前を使用してください。」となってしまう。。

For gyo = 2 To 21

Worksheets.Add


ActiveSheet.Select
ActiveSheet.Name = Worksheets("main").Range("B" & gyo).Value


Next


End Sub





[ 続きを読む]  返信件数:3件  [ 動画を見る] 

[3331] 発展編1 フォローメールセミナー 第1回

伊久間博之さんからの投稿です。

For Nextのカウンターが終わるコードを書いてみました。


Sub torihikisaki_meisyou()
Dim gyo
Dim sita
sita = Range("B" & Rows.Count).End(xlUp).Row

For gyo = 2 To sita
Debug.Print Range("B" & gyo)
Next
End Sub



テーブルの最終行を取得するコードは業務でよく使うのですんなり書けたつもりでいたのですが、最初に


sita = Range("B" & Columns.Count).End(xlUp).Row


と書いていたことに気づかず、期待通りの結果が返ってきて安心。もう一度見直して間違いに気付きました。
Columns.Countに256が入るのでたまたま上手く行っただけなんですね。アブナイアブナイ。

[ 続きを読む]  返信件数:1件  [ 動画を見る] 

[3300] 発展編1 フォローメールセミナー 第25回

受講生さんからの投稿です。

このあたりになるとかなり難しく感じられるため、何とか読めても一から書けと言われると無理です。
今回の場合はシート名が数字から始まるために「'」でシート名が囲まれているのだと思うのですが、
「'」を付け忘れても自動で補完されるように思えます。
それでも「'」は意識的につけた方がいいのでしょうか?

[ 続きを読む]  返信件数:1件  [ 動画を見る] 

[2886] 発展編1 フォローメールセミナー 第24回

受講生さんからの投稿です。

WithとOffsetの連携により、定数を使わなくても可読性・メンテナンス性がいいものができることが分かりました。
課題は何とかできましたが、あまり自信がありません。とにかく動くものを作るだけで精一杯です。
明日の解説で確認します。

[ 続きを読む]  返信件数:1件  [ 動画を見る] 

[2883] 発展編1 フォローメールセミナー 第23回

受講生さんからの投稿です。

曜日はFormat関数を使用し、数式を入れる部分は、R1C1形式を使ってしまいました。
Addressプロパティを使用すると、可読性が良くなるのですね。ついでに相対参照にしておきました。
課題[3]でOffsetを使いWithでまとめる方法は、参考になりました。
課題[4]はよく分からなかったので、明日の解答を確認してみます。

[ 続きを読む]  返信件数:1件  [ 動画を見る] 

[2879] 発展編1 フォローメールセミナー 第22回

受講生さんからの投稿です。

月末を求めるのではなく、月が同じである間ループを繰り返すという発想、
一度作成したプロシージャを分割していくという発想が、大変参考になりました。
何度も手を動かしながら、身につけていきたいと思います。

[ 続きを読む]  返信件数:1件  [ 動画を見る] 

[2878] 発展編1 フォローメールセミナー 第21回

受講生さんからの投稿です。

この例のように、1列でもSelectionが活躍するのですね。
範囲選択せずに実行してしまうことが多いのですが、徐々に慣れていきたいと思います。

[ 続きを読む]  返信件数:1件  [ 動画を見る] 

[2860] 発展編1 フォローメールセミナー 第20回

受講生さんからの投稿です。

アイデア次第で、いろいろな使い方があるのですね。
こういうマクロをサクッと作れるようになりたいです。

[ 続きを読む]  返信件数:1件  [ 動画を見る] 

[2857] 発展編1 フォローメールセミナー 第19回

受講生さんからの投稿です。

今までStep -1で対応していました。
>Rows(48 - ln & ":" & 48 - ln).Delete
":"はつけなくても動作すると思うのですが、つけた方がいいのでしょうか?

[ 続きを読む]  返信件数:1件  [ 動画を見る] 

[2856] 発展編1 フォローメールセミナー 第18回

受講生さんからの投稿です。

使い捨てのマクロでは"Selection"で楽ができるのですね。参考になります。
改行は今までvbLfかvbCrLfを使用していたため、vbNewLineを初めて知りました。

[ 続きを読む]  返信件数:1件  [ 動画を見る] 

[2839] 発展編1 フォローメールセミナー 第17回

受講生さんからの投稿です。

放送回数の取得方法が、大変参考になりました。
最終回の放送回数も見逃していました。

[ 続きを読む]  返信件数:1件  [ 動画を見る] 

[2828] 発展編1 フォローメールセミナー 第16回

受講生さんからの投稿です。

ここまで何とか追いつきました。一応予習課題もできました。

[ 続きを読む]  返信件数:2件  [ 動画を見る] 


各講座ごとのメッセージを見る場合はこちら

まずはここから!スマホでも学べる無料動画講座

今なら先着30名限定で無料!定価4,800円の、初心者のためのエクセルマクロ動画講座。
  1. Excel 97~Excel 2016まですべて対応。動画本数20本、総再生時間2時間44分53秒
  2. PC, Mac, iPhone, iPad, Androidのお好みの環境で、いつでも好きなときに学べます。
2004年から10年間述べ3,000名以上に実施した研修の経験と実績を集約した講座です。
いますぐ無料で試してください。

トップへ