utf8

あいうえお
かきくけこ

■2024/07/24 21:41:52

連番を生成するsql

SELECT  LEVEL
FROM DUAL
CONNECT BY LEVEL <= 6;

LEVEL
1
2
3
4
5
6





SQLのサンプルを作成してください
今年12か月分の年月を出力する

SELECT TO_CHAR(ADD_MONTHS(TRUNC(SYSDATE, 'YEAR'), LEVEL - 1), 'YYYY-MM') AS year_month
FROM DUAL
CONNECT BY LEVEL <= 6;

2024-01
2024-02
2024-03
2024-04
2024-05
2024-06


■2024/07/24 22:40:35

KEY1Ｍ]KEY2内で、KEY3が一番大きいであるレコードを出力
SELECT 
	TEST05.* 
FROM TEST05
WHERE KEY3 =
(
	select
		MAX(KEY3)
	FROM TEST05 T_MAX
	WHERE 
		T_MAX.KEY1 = TEST05.KEY1
	AND	T_MAX.KEY2 = TEST05.KEY2
		
)

■2024/07/25 00:11:04
ORACLE sql を教えてください。
該当する日付があれば、その値。無ければ過去直近の値がほしい

SELECT *
FROM 
(
	
	SELECT 
		1
		,YM.YEAR_MONTH
		,TEST05.DATA1
		,TEST05.DATA2
		
		,LLL.DATA1 B1
		,LLL.DATA2 B2
		
		 ,rank() over( partition by YEAR_MONTH order by LLL.DATA1 desc) RANK
		
	FROM	
		(
			SELECT TO_CHAR(ADD_MONTHS(TRUNC(SYSDATE, 'YEAR'), LEVEL - 1), 'YYYYMM') AS year_month
			FROM DUAL
			CONNECT BY LEVEL <= 6
		)  YM
	
	LEFT JOIN TEST05
	ON TEST05.DATA1 = YM.YEAR_MONTH
	AND TEST05.KEY1 = 100
	
	-- ここだけで良い カレント以下のデータを繋げて、ランク１だけにすればできる
	LEFT JOIN TEST05 LLL
	ON LLL.DATA1 <=YM.YEAR_MONTH
	AND LLL.KEY1 = 100
)	
WHERE 	RANK = 1

ORDER BY YEAR_MONTH


■2024/07/28 00:36:32

上記
CONNECT BY LEVEL <= 6 のこの「6」を
データに範囲で求めるには
select LEVEL
from dual
CONNECT BY LEVEL <= (
                        select 
                            MONTHS_BETWEEN(
                                 to_date(max(DATA1),'yyyymm')
                                ,to_date(min(DATA1),'yyyymm')
                            )
                        from TEST05
                    )
とすればできる
	

■2024/07/25 22:24:44

https://www.moug.net/tech/exvba/0100049.html

配列をセルに一括で代入する

Sub Sample1()
    Dim tmp(2) As String
    tmp(0) = "Excel"
    tmp(1) = "Word"
    tmp(2) = "Access"
    Range("A1:C1") = tmp
End Sub

ただし、このような一次元配列を一括代入できるセル範囲は、
「横方向のセル範囲」です。


一次元配列である限り、そのまま一括代入はできません。
縦方向のセル範囲に一括代入するには、元の配列が二次元配列でなければなりません。
たとえば次のような配列です。

Sub Sample3()
    Dim tmp(2, 0) As String
    tmp(0, 0) = "Excel"
    tmp(1, 0) = "Word"
    tmp(2, 0) = "Access"
    Range("A1:A3") = tmp
End Sub



Excelには、横方向の表を縦方向に変換して貼り付ける機能があります。
そう「形式を選択して貼り付け」の「行列の入れ替え」です。
さらに、このような行列の変換を行うワークシート関数もあります。
それがTRANSPOSE関数です。
TRANSPOSE関数を使えば、一次元配列を二次元配列に一発で変換して、縦方向のセル範囲に代入できます

Sub Sample4()
    Dim tmp(2) As String
    tmp(0) = "Excel"
    tmp(1) = "Word"
    tmp(2) = "Access"
    Range("A1:A3") = WorksheetFunction.Transpose(tmp)
End Sub



■2024/07/28 21:49:03

セルエリアへの設定
これが一番早かった

Sub test5()

    Dim sw As New StopWatch
    
    sw.Start



    Dim arr1(1 To 3) As String
    Dim arr2(1 To 2) As String
    Dim arr3(1 To 3) As String


   Application.ScreenUpdating = False
    
    Dim arrRange1 As Range
    Dim arrRange2 As Range
    Dim arrRange3 As Range
    
    Set arrRange1 = Range(Cells(3, 2), Cells(3, 4))
    Set arrRange2 = Range(Cells(3, 6), Cells(3, 7))
    Set arrRange3 = Range(Cells(3, 9), Cells(3, 11))
    
    Dim i As Long
    
    Dim X As Long
    
    For i = 1 To 10000
            
        X = X + 1
        arr1(1) = X
        
        X = X + 1
        arr1(2) = X
        
        X = X + 1
        arr1(3) = X
        
        
        
        X = X + 1
        arr2(1) = X
        
        X = X + 1
        arr2(2) = X
        
        
        
        X = X + 1
        arr3(1) = X
        
        X = X + 1
        arr3(2) = X
        
        X = X + 1
        arr3(3) = X
        

        
        
        arrRange1.Value = arr1
        arrRange2.Value = arr2
        arrRange3.Value = arr3
    
    
    Next i
    
   Application.ScreenUpdating = True

    sw.MarkingTime
    
    MsgBox sw.GetHHMMSSmmm

    '1.131

End Sub




■2024/07/28 21:50:25

ストップウォッチクラス

Option Explicit

'http://www.microsoft.com/japan/msdn/vbasic/migration/tips/Stopwatch/

Private Declare PtrSafe Function timeGetTime Lib "winmm.dll" () As Long

Private mStartTime  As Long
Private mEndTime    As Long


Public Sub Start()
    mStartTime = timeGetTime
End Sub

Public Sub MarkingTime()
    mEndTime = timeGetTime
End Sub

Public Function GetSecond() As Double
    
    Dim millisecondSpan As Long
    
    millisecondSpan = mEndTime - mStartTime
    
    GetSecond = millisecondSpan / 1000
    
End Function

Public Function GetHHMMSSmmm() As String


    Dim HH As Long
    Dim MM As Long
    Dim SS As Long
    Dim milli As Long
    Dim Second As Double
    
    Second = GetSecond
    
    '時間
    HH = Second \ 3600
    
    '分
    MM = (Second - HH * 3600) \ 60
    
    '秒
    SS = (Second - HH * 3600 - MM * 60) \ 1
    
    'ミリ秒
    milli = (Second - Int(Second)) * 1000
    
    GetHHMMSSmmm = Format$(HH, "00") + "時間 " + Format$(MM, "00") + "分 " + Format$(SS, "00") + "秒 " + Format$(milli, "000")
    
End Function





■2024/08/03 19:08:15


FROM TO 等で、マスタが複数連結されてしまう場合の考慮の例

WITH MMMM
AS 
(
	SELECT
		 TRAN.ROWID TRAN_ROWID
		,TRAN.KEY1
		,TRAN.DATA2
		
		,MST1.CD MST1_CD
		,MST2.CD MST2_CD
	
		,row_number() over( partition by TRAN.ROWID order by MST1.cd,MST2.CD)  MST1_RN
		
	FROM
		TRAN
		
	LEFT JOIN MST MST1
	ON 	MST1.KEY1 = TRAN.KEY1
	AND TRAN.KEY2 BETWEEN MST1.DT_FROM AND MST1.DT_TO
	AND MST1.DATA2 = TRAN.DATA2
	
	LEFT JOIN MST MST2
	ON 	MST2.KEY1 = 'T002'
	AND TRAN.KEY2 BETWEEN MST2.DT_FROM AND MST2.DT_TO
	AND MST2.DATA1 = MST1.DATA1
)
SELECT 
	TRAN.*
	,MMMM.MST2_CD	
FROM 
	TRAN

LEFT JOIN  MMMM
ON MMMM.TRAN_ROWID = TRAN.ROWID

WHERE 
	MMMM.MST1_RN = 1



■2024/09/16 10:08:10

対象リストから対象外リストへの引っ越し



'対象シートの中から、対象外データを、対象外シートに移動する
Sub main()
    
    '今の自動計算を保存
    Dim nowXlCalculation As XlCalculation
    nowXlCalculation = Application.Calculation
    
    '自動計算オフ
    Application.Calculation = xlManual


    With SheetMoto
    
        '計算式を埋め込む
        SetFunctionMATCH
        
        'オートフルタを設定する
        If .AutoFilterMode Then
            .Rows(1).AutoFilter
        End If
        .Rows(1).AutoFilter 7, -1
        
        'フォルタ後 データが無いときは、抜ける
        If WorksheetFunction.Subtotal(3, .Columns(1)) > 1 Then
        Else
            'フォルタ後 データが無いときは、抜ける
            GoTo END_SUB
            Exit Sub
        End If
    
    End With
    
    'オートフィルタの対象行を取り出し
    Dim motoRange As Range
    With SheetMoto.Cells(1, 1).CurrentRegion
        'ヘッダ行を抜く
        Set motoRange = .Offset(1, 0).Resize(.Rows.Count - 1)
    End With
        
    '表示されている行をloop
    Dim wkRow As Range  'each処理用の行
    
    Dim errSheet As Worksheet
    
    Set errSheet = Sheet6
    
    Dim wkErrRow As Range
    
    'これは、プロト版のみ
    Dim errPutedRow As Long
    errPutedRow = 1
    
    
    Dim motoRowValues() As Variant
    Dim errRowValues()  As Variant
    
    For Each wkRow In motoRange.SpecialCells(xlCellTypeVisible).Rows
        
        motoRowValues = wkRow.Value
        
        'errRowValues を初期化する
        ReDim errRowValues(1 To 4)
        
        '並びを調整して、編集
        errRowValues(1) = motoRowValues(1, 1)
        errRowValues(2) = motoRowValues(1, 2)
        errRowValues(3) = motoRowValues(1, 3)
        errRowValues(4) = motoRowValues(1, 4)
        
        
        '編集先に書き込み
        With errSheet
            Set wkErrRow = .Range(.Cells(errPutedRow, 1), .Cells(errPutedRow, 4))
        End With
        wkErrRow.Value = errRowValues
        
        errPutedRow = errPutedRow + 1
        
    Next wkRow
        
        
    'オートフィルタで抽出した行を削除する
    motoRange.EntireRow.Delete
    
    GoTo END_SUB
    
    Exit Sub

END_SUB:

    '自動計算モードを戻す
    Application.Calculation = nowXlCalculation
        
    With SheetMoto
    
        'フィルタをはずす
        .Rows(1).AutoFilter
    
        '埋め込んだ計算式をクリアする
        .Range(.Columns(5), .Columns(7)).Clear
                
    End With
    

End Sub



Public Function OwnBsse(in_Base) As String

    If in_Base = "America上流" Then
        OwnBsse = "America"
    ElseIf in_Base = "America下流" Then
        OwnBsse = "America"
    Else
        OwnBsse = in_Base
    End If
     
    
    
End Function

Public Function SearchBsse(in_Base) As String

    If in_Base = "America上流" Then
        SearchBsse = "Paris"
    ElseIf in_Base = "America下流" Then
        SearchBsse = "Paris"
    Else
        SearchBsse = "America"
    End If
          
    
End Function


Public Function SetFunctionMATCH()

    
    With SheetMoto
        .Range(.Cells(2, 5), .Cells(1002, 5)).Formula = "=CONCAT(A2:B2,OwnBsse(C2),D2)"
        .Range(.Cells(2, 6), .Cells(1002, 6)).Formula = "=CONCAT(A2:B2,SearchBsse(C2),D2)"
        .Range(.Cells(2, 7), .Cells(1002, 7)).Formula = "=IFERROR(MATCH(E2,F:F,0),-1)"
    
    End With

End Function