LAN-PRO

Oct

15,

2022

今日の日の出(2022.10.16)😄

日の出位置が、小牧山と猿投山の中間あたりまできました。
まもなく、猿投の北麓にかかります・・

今日は柿園で収穫のお手伝いです・・・

わかお　かずまさ

VegaSystems

📷📷📷📷📷📷
#LAN_PRO
#Bloguru
#kuma_ichinomiya
#VegaSystems
#photography_Ichinomiya
#X100V
#sunrise_ichinomiya
#Sunset_ichinomiya
#日の出_一宮
#夜明け_一宮

#kuma

Oct

15,

2022

Excel-VBA 処理速度を上げる

ExcelVBA]での処理速度を上げる簡単な方法。
Sheetを切り替えての処理の場合、Sheetの描画に時間とPowerを使います。
以下の一行をSourceに入れておけばOKです。
画像を表示させない命令です。

Application.ScreenUpdating = False

わかお　かずまさ

VegaSystems

📷📷📷📷📷📷
#LAN_PRO
#Bloguru

#kuma

Oct

15,

2022

ExcelVBAでのCall文での変数の引き渡し

Call文を呼び出す場合、（）内に変数を指定して渡さないと、引き継ぎが
出来ません。プログラムの素養があればわかることですが、初めての方には
理解出来ない部分です。

以下　Source

Loopの中で、Graph()をCallしています、この時Sheet名を渡しています。
Sourceは2つあり、後半が呼び出される部分です。

Sub CREATE_Graph()
'
' CREATE_Graph Macro

Dim i As Long

Dim She_nam As String

Application.ScreenUpdating = False

For i = 1 To 31

Sheets("SKD1-A").Select

Range(Cells(7, i + 2), Cells(56, i + 2)).Select

Selection.Copy

If i < 10 Then

She_nam = "SKD2-0" & Right(Val(i), 2)

Else

She_nam = "SKD2-" & Right(Val(i), 2)

End If

' Debug.Print She_nam

Sheets(She_nam).Select

Range("C4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Call Graph(She_nam)

Next i

Range("A1").Select

Sheets("SKD1-A").Select

Range("A1").Select

End Sub

'
End Sub

-----------------------------------------------------
Sub Graph(S_nam)
'
' Macro3 Macro
'

'Shiftの勤務時間を横棒グラフに展開する

Sheets(S_nam).Select
ActiveWindow.SmallScroll Down:=-6

Dim Cnt As Double
Dim Haji_n As Double
Dim Naga_n As Double

Dim X_n As Double
Dim Xe_n As Double
Dim Y_n As Double

Dim Jikan As String '設定勤務時間
Dim Haji As String '開始時刻
Dim Naga As String '仕事時間

'----------------------------
'グラフ画面の初期化

Range("D4:AN53").Select

With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With

Selection.ClearContents
'-----------------------------

For i = 1 To 50

Y_n = i + 3

Jikan = Cells(Y_n, 3)

If Val(Jikan) = 0 Then
GoTo Continue '未記入はPASS
End If

Cnt = InStr(Jikan, "+") '+の位置の検出

Haji = Left(Jikan, Cnt - 1)
Haji_n = Val(Haji)

If Haji_n < 6 Then
Haji_n = 6 '6時以前は6時にfix
End If

Haji_n = Haji_n * 2 'グラフの長さのため2倍に

X_n = Haji_n - 8

Naga = Mid(Jikan, Cnt + 1)
Naga_n = Val(Naga) * 2

Xe_n = Naga_n + Haji_n - 8

If Xe_n > 40 Then
Xe_n = 40 '24時以降は24時に
End If

'Debug.Print Haji_n
'Debug.Print Haji_n - 8

'Debug.Print Naga_n
'Debug.Print Naga_n + Haji_n
'Debug.Print Naga_n + Haji_n - 8

'Debug.Print Y_n
'Debug.Print X_n
'Debug.Print Xe_n

''------------------------------------------------
'勤務時間横グラフ作成

Cells(Y_n, X_n) = Naga_n / 2 '勤務時間を先頭に記入

Range(Cells(Y_n, X_n), Cells(Y_n, Xe_n - 1)).Select

With Selection.Interior

.Pattern = xlSolid
.PatternColorIndex = xlAutomatic

' .Color = 5296274

' .ColorIndex = 42

' Debug.Print Haji_n

Select Case Haji_n '勤務開始時刻で色を決める

Case Is < 24

.ColorIndex = 42

Case 23 To 36

.ColorIndex = 44

Case Is > 35

.ColorIndex = 26

Case Else

.ColorIndex = 3

End Select

.TintAndShade = 0
.PatternTintAndShade = 0

End With
'------------------------------------------

Continue:

Next

End Sub

わかお　かずまさ

VegaSystems

📷📷📷📷📷📷
#LAN_PRO
#Bloguru

#kuma

Oct

15,

2022

Excel-VBA 汎用BackUp

ExcelのバックアップのVBAです。
OneDriveなどで複数のPCでの使用を想定しています。
基本的にローカルにBackUpする方法。
日時をファイル名に書き込んでいます、もう一点。
PCのユーザ名を検出して汎用性を上げています。

以下、Source
Sub Backup()
'
' Backup Macro

'

Dim xlTime As String
Dim xlName As String
Dim U_Nam As String
Dim Fld_Nam As String

U_Nam = Environ("USERNAME")

Fld_Nam = "C:\Users\" & U_Nam & "\Desktop\TH-BACKUP\" ' Folder名を指定

' 　ファイル名を取得
xlName = ThisWorkbook.Name

' 　年月日自分を取得
xlTime = Year(Date) & Format(Month(Date), "00") & _
Format(Day(Date), "00") & _
Format(Hour(Now), "00") & _
Format(Minute(Now), "00")

' 　コピー保存用ファイル名設定
xlName = Left(xlName, InStrRev(xlName, ".")) & xlTime & "_BACKUP"

xlName = Fld_Nam & xlName

Debug.Print xlName

' 　ファイルをコピーして保存する
ThisWorkbook.SaveCopyAs xlName & ".xlsm"

わかお　かずまさ

VegaSystems

📷📷📷📷📷📷
#LAN_PRO
#Bloguru

#kuma

Oct

15,

2022

今日の夜明け前2(2022.10.15)

今日も日の出の陽光は見ることが出来なさそう・・・・

この後、山に出かけます。

わかお　かずまさ

VegaSystems

📷📷📷📷📷📷
#LAN_PRO
#Bloguru
#kuma_ichinomiya
#VegaSystems
#photography_Ichinomiya

#GFX50S2

#sunrise_ichinomiya
#Sunset_ichinomiya
#日の出_一宮
#夜明け_一宮
#トレッキング
#trekking

#kuma