stgtの日記

思い付き、気になったことを覚えておけない。

クリップボード貼り付け

vba 
Private Declare PtrSafe Function OpenClipboard Lib "USER32" (Optional ByVal hwnd As Long = 0) As Long
Private Declare PtrSafe Function CloseClipboard Lib "USER32" () As Long
Private Declare PtrSafe Function EmptyClipboard Lib "USER32" () As Long
Private Declare PtrSafe Function GetInputState Lib "USER32" () As Long
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As Long)

Dim isContinue_ As Boolean
Dim targetSheet_ As Worksheet
Dim pasteRow_ As Integer
Const pasteCol_ As Integer = 2

Sub Kicker()
        
    MsgBox "AutoCaptureを開始"

    ' 貼り付けシート習得と貼り付け開始行の取得
    Call Preparation
    Call AutoCapture
End Sub

Private Sub AutoCapture()
    Dim cbFormat As Variant
    Dim sh As Worksheet
    
    'クリップボードの形式取得する。
    cbFormat = Application.ClipboardFormats
    
    If cbFormat(1) <> -1 Then
        
        targetSheet_.Paste Destination:=targetSheet_.Cells(pasteRow_, pasteCol_)
        
        ' 貼り付け行更新
        UpdateRow (cbFormat)
        
        'クリップボードを空にする。
        OpenClipboard
        EmptyClipboard
        CloseClipboard
    End If
    
    DoEvents
    If isContinue_ = True Then
        Application.OnTime DateAdd("s", 1, Now), "AutoCapture"
    End If
    'Application.ScreenUpdating = True
    
End Sub

Private Sub Preparation()
    Dim ws As Worksheet, isExist As Boolean, name As String
    
    ' 初期化
    pasteRow_ = 1
    isContinue_ = True
    
    'クリップボードを空にする。
    OpenClipboard
    EmptyClipboard
    CloseClipboard
    
    ' 貼り付けシートの準備
    With ThisWorkbook
        
        name = .Sheets("menu").Cells(8, 7).Value
        For Each ws In .Worksheets
            If ws.name = name Then isExist = True
        Next ws
    
        If isExist = True Then
            Set targetSheet_ = .Sheets(name)
            
            With targetSheet_
                If IsEmpty(.Cells(1, 1)) Then
                    pasteRow_ = 1
                Else
                    pasteRow_ = .Cells(1, 1).Value
                End If
            End With
        Else
            ' 新規シートに貼り付け
            
            Worksheets.Add After:=Worksheets(Worksheets.Count)
            ActiveWindow.View = xlPageBreakPreview
            
            .ActiveSheet.name = name
            Set targetSheet_ = .ActiveSheet
            
            .Sheets("menu").Select
        End If

    End With
    

End Sub

Sub Kill()
    isContinue_ = False
    
    ' 終了時に再開時用に貼り付け行をセルに保管
    With targetSheet_.Cells(1, 1)
        .Locked = False
        .Font.ColorIndex = 2 ' 白
        .Value = pasteRow_
        .Locked = True
    End With
    
    MsgBox "AutoCaptureを終了"
End Sub

Private Function UpdateRow(cbFormat As Variant)
    Dim isImg As Boolean
    isImg = False
    
    With targetSheet_
        ' 画像の場合、画像の高さから次の貼り付け位置の更新
        For Each fmt In cbFormat
            If fmt = xlClipboardFormatBitmap Then
                lastImg = .Shapes.Count
                imgHeighet = .Shapes(lastImg).Height
                cellHeight = .Cells(1, 1).RowHeight
                
                pasteRow_ = pasteRow_ _
                        + Round(imgHeighet / cellHeight) _
                        + 3
                        
                isImg = True
            End If
        Next
        
        ' 画像以外の場合
        If isImg = False Then
            With .Cells(pasteRow_, pasteCol_).CurrentRegion
                pasteRow_ = .Row + .Rows.Count
            End With
        End If
    
    End With
End Function

Sub SaveSheet()
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
     
    '新規ブックのファイルパスを設定
    Dim filePath As String
    filePath = ThisWorkbook.Sheets("menu").Cells(9, 7).Value
    
    ' 新規ブックを作成する
    With Workbooks.Add
     
        For Each sh In ThisWorkbook.Worksheets
            If sh.name <> "menu" Then
                sh.Copy After:=.Sheets(.Worksheets.Count)
            End If
        Next
        .Sheets("Sheet1").Delete
        
        ' 新規作成したブックを保存する
        ' 拡張子が.xlsxの場合はxlOpenXMLWorkbook
        .SaveAs Filename:=filePath, _
                FileFormat:=Excel.XlFileFormat.xlOpenXMLWorkbook
         
        ' 新規作成したファイルを閉じる
        .Close
    End With
     
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

シートを作成しながら、累計を計算

vba 
Sub Create()
    Dim DataRange As Range
    Dim DataArr As Variant, Row As Variant
    Dim StartTime As Date, EndTime As Date
    Dim Cumulative As Double
    
    Set DataRange = Worksheets("form").Cells(5, 9).CurrentRegion
    
    IsErr = CheckData(DataRange)
    If IsErr = True Then
        MsgBox "入力値にエラーが存在します。"
        Exit Sub
    End If
    
    DataArr = DataRange
    
    For Row = 1 To UBound(DataArr, 1)
        StartTime = DataArr(Row, 1)
        EndTime = DataArr(Row, 2)
        
        Worksheets("format").Copy After:=Worksheets(Worksheets.Count)
        
        With ActiveSheet
        
            .Name = Format(StartTime, "yyyymmdd")
            .Cells(5, 2) = Format(StartTime, "Long Date")
            
            .Cells(7, 2) = Format(StartTime, "m")
            .Cells(7, 3) = Format(StartTime, "d")
            .Cells(7, 4) = Format(StartTime, "h")
            .Cells(7, 5) = Format(StartTime, "n")
            
            .Cells(10, 2) = Format(EndTime, "m")
            .Cells(10, 3) = Format(EndTime, "d")
            .Cells(10, 4) = Format(EndTime, "h")
            .Cells(10, 5) = Format(EndTime, "n")
            
            mindiff = DateDiff("n", StartTime, EndTime)
            workTime = WorksheetFunction.Ceiling(mindiff / 60, 1 / 2)
            .Cells(13, 2) = workTime
            
            Cumulative = Cumulative + workTime
            .Cells(13, 3) = Cumulative
            
        End With
    Next
End Sub

Private Function CheckData(DataRange As Range)
    Dim ErrArr As Variant
    Dim StartCell As Range
    Dim EndCell As Range

    DataRange.Interior.ColorIndex = 0
    CheckData = False
      
    For Row = 1 To DataRange.Rows.Count
        
        Set StartCell = DataRange.Cells(Row, 1)
        Set EndCell = DataRange.Cells(Row, 2)
        
        If IsDate(StartCell.Value) = False _
                Or IsDate(EndCell.Value) = False Then
            StartCell.Interior.Color = RGB(255, 150, 150)
            EndCell.Interior.Color = RGB(255, 150, 150)
            
            CheckData = True
        End If
    Next
End Function

以下、メモ書き

Set DataRange = Worksheets("form").Cells(5, 9).CurrentRegion

CurrentRegionで空行までの範囲を取得(Range) f:id:stgt:20190730071245p:plain

ドキュメントをあさる際のあれこれ

PowerShell

目次

正規表現

コメント行検索

^.*//.*$
削除する場合は^.*//.*\r\nを置換

空白行検索

^\r\n
行先頭が改行コード

特定の文字列を含まない行を検索

^(?!.*test).*$
特定の文字列が「test」の場合
欲しい内容以外の行を削除する際に、
置換することで「test」を含まない行を削除

PowerShell

1.ファルダ内ファイル検索

再帰的に検索

$Name = "ファイル名"
Get-Childitem -File C:\src\ -r -Filter $Name | % {$_.Fullname}

上記結果をOut-Fileでファイルに出力し、
サクラエディタで開くとパスクリックでファイルを開けて便利

2.grep

上記のファイル検索と組み合わせて

Select-String "readme" (Get-Childitem -File C:\src\ -r)

3.ファイルを階層を保持してコピー

コピー元とコピー先のディレクトリを指定
ファイル検索し、コピー元指定ディレクトリ以降の構成でコピーする

コード

#$Arg1は「*.txt」とか「Readme*」とかコピーしたいファイル
Param(
    [parameter(mandatory=$true)][String]$Arg1,
    # コピー元
    [Parameter()][String]$Arg2 = "C:\Program` Files",
    # コピー先
    [Parameter()][String]$Arg3 = "C:\backup"
)

# C:\Program Files\App\readme.txt
# 引数指定以降のパスが取れる（App\readme.txt）
$src = Get-Childitem $Arg2 -r -Filter $Arg1 -Name

$src `
| %{ [PSCustomObject]@{
    Path = Join-Path $Arg2 $_
    Destination = Join-Path $Arg3 $_
    }}`
| %{
   
    # ディレクトリの存在しないパスに絶対パスを指定し、コピーをすると
    # エラーとなるため、最初にディレクトリ生成
    $DirectoryName = Split-Path -Parent $_.Destination
    New-Item $DirectoryName -ItemType Directory -Force

    # 同一階層にコピー
    Copy-Item -Path $_.Path -Destination $_.Destination -Force
    }
New
Param(
    [Parameter(Mandatory=$true)]
    [ValidateScript({Test-Path -LiteralPath $_ -PathType Container})]
    [String]
    $srcPath,
    [Parameter(Mandatory=$true)][String]
    $destPath,
    [Parameter(Mandatory=$true)][String]
    $filter
)

$null = New-Item $destPath -Force -ItemType Container

# C:\Program Files\App\readme.txt
# 引数指定以降のパスが取れる（App\readme.txt）
$obj = Get-ChildItem "${srcPath}" -Recurse -File -Filter "${filter}" -Name |`
    Select-Object -Property @{ Name = "src";  Expression = { Join-Path $srcPath $_ }},`
                            @{ Name = "dest"; Expression = { Join-Path $destPath $_ }},`
                            @{ Name = "name"; Expression = { Split-Path -Leaf $_ }},`
                            @{ Name = "type"; Expression = { if (Test-Path (Join-Path $destPath $_)) {
                                                                "上書き"
                                                             } else {
                                                                "新規  "
                                                             } }
                             }
#実行確認
###
Write-Host @"

以下、$(@($obj).Count)件のファイルをコピーします
"@
###

#ファイル情報出力
$obj | Sort-Object type | Format-Table type, name -AutoSize

###
[String]$response = Read-Host @"
【${srcPath}】
  →【${destPath}】

よろしいですか？ (y/n)
"@
###

if ($response -ne "y") {
    Write-Host "処理を中断しました"
    exit
}

#ファイルコピー
$obj | %{
    $DirectoryName = Split-Path -Parent $_.dest
    if (!(Test-Path $DirectoryName)) {
        New-Item $DirectoryName -ItemType Directory -Force
    }
    # 同一階層にコピー
    Copy-Item -Path $_.src -Destination $_.dest -Force
}

Write-Host "Done"

srcPath: C:\src
destPath: C:\backup
filter: readme*

以下、3件のファイルをコピーします

type   name
----   ----
上書き Readme.txt
新規   Readme.txt
新規   README.md


【C:\src】
  →【C:\backup】

よろしいですか？ (y/n): y

フルパスを表示したほうがいいかもしれない

結果

「readme*」を第一引数に与えて実行
元

C:\PROGRAM FILES
├─Test
│  └─Test Software
│          Readme.txt
│
├─WindowsPowerShell
│  └─Modules
│      └─Pester
│          └─3.4.0
│                  README.md
(省略)

先

C:\BACKUP
├─Test
│  └─Test Software
│          Readme.txt
│
└─WindowsPowerShell
   └─Modules
       └─Pester
           └─3.4.0
                   README.md

pyenvとanaconda

ubuntu

参考にした。というか、そのまんま。

qiita.com

Linuxの場合の部分をそのまま行った。

echo 'export PATH="$PYENV_ROOT/versions/anaconda3-2.5.0/bin/:$PATH"' >> ~/.bashrc

だとディレクトリごとにpythonのバージョンを決められるpyenv localとやらが使えないそうだが、難しいことはよくわからないので単純な方法をとることにした。

必要があればこのサイトを参考に変更すること。

ubuntuのLive USB作成

ubuntu

ubuntu 16.04 LTS

 

最初にセキュアブートは無効にする。

インストールメディアの作成とLive USB作成で参考にした。

UbuntuのLive USBをつくる – mktiaの備忘録

HDDのパーティション作成。

Ubuntu 11.04 をUSBメモリにインストールする | シログ

Live USBの作成はできたが、Windowsが起動できなくなった。Live USBを作成するときの、UEFIがどうのこうのとどまるかとどまらないかみたいなところで失敗したかも。

 

BIOSでLive USBを認識していなかったが、Legacy supportを有効にすることでubuntuを起動できた。

 

無線lanがつながらなかったので、ドライバのインストールを参考にした。

ファイルは最初に作成したインストールメディアからコピーした。

OS X El CapitanとUbuntu 16.04 LTSのデュアルブート環境を構築する – OTTAN.XYZ

 

再起動すると無事接続。

 

TensorFlowを使えるようにしていく。

footballista APR 2017

football

「ポジション」多様化時代へようこそ

注目クラブのコンバート起用のケーススタディを分析する特集。戦術論に関する気になったワード、Webページを書き留めておく。

5レーン理論

攻撃時に敵最終ラインの手前で5つの縦レーンをすべて埋める攻め方。ペップ時代のバルサが代表。FC岐阜の攻め方もこれにあたる気がする。

ポジション名

各国で様々な呼称が存在し、イメージが共有されている。イタリア語の演出家の意味でゲームメーカーを指す「レジスタ」や出会う人の意味で守備的MFを指す「インコントリスタ」など。

また、戦術用語も多く存在しする。スペイン語では、マークを外す動きにも特別な用語が与えられているらしい。各国の専門用語を調べると面白いかもしれない。

ランチェスターの法則

世界大戦の集団戦闘を分析し、発見された数理モデル。戦術の理論。様々な分野に応用されている。

ランチェスターの法則 - Wikipedia

Ultimo Uomo(ウルティモ・ウオモ)

分析レポートを掲載するWebマガジン。イタリア語。

www.ultimouomo.com

ポジション名、戦術用語集を作る。また、FC岐阜へ活用できそうな戦術について調べる。

 

あと、戦術は関係ないけど、ニコ・コバチ監督へのインタビューから気になった話。

「多くの選手は左足と右足、体の前側と後ろ側、股関節周りのバランスが非対称」

 一般人はなおさらそうであると思う。改善するために何をしようか。