Share Code Quickly

What is Harigami?

Harigami is a simple source code sharing service. You can share source code by an URL which is issued after submission.
You can also run your source code online such as Python, Ruby, JavaScript and so on.
For free.Use for code review.

Enter code which you want to share Select language

Check to hide your code on timeline Preferences

123 4 5 6…323 324

セミオートログイン　Ver.2

VBA

Option Explicit

Sub リンク作成()
    
    Dim i As Long
    For i = 3 To Cells(Rows.Count, 2).End(xlUp).Row
        Hyperlinks.Add anchor:=Cells(i, 3), Address:="", SubAddress:="", TextToDisplay:="実行"
    Next
    
End Sub

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
    
    Dim ジャンル As String
    ジャンル = Target.Range.Offset(0, 1).Value
    
    Dim 最初のセル As Range
    Set 最初のセル = Target.Range.Offset(0, 2)
    
    Select Case ジャンル
        Case "フォルダ"
            Call フォルダ(最初のセル)
        Case "Zoom"
            Call Zoom(最初のセル)
    End Select
    
End Sub

Sub フォルダ(ByVal セル As Range)
    
    Rem コピー1
    セル.Copy
    AppActivate "*無題 - メモ帳"
    Call ySendKeys("^V")
    Call ySendKeys("{TAB}")
    
    Rem コピー2
    セル.Offset(0, 1).Copy
    Call ySendKeys("^V")
    Call ySendKeys(" ")
    Call ySendKeys("{TAB}")
    
    Application.CutCopyMode = False
    
End Sub

Sub Zoom(ByVal セル As Range)
    
    Rem コピー1
    セル.Copy
    AppActivate "Zoom"
    Call ySendKeys("^V")
    Call ySendKeys("{TAB}{TAB}{TAB}{TAB}")
    Call ySendKeys(" ")
    Call ySendKeys("{TAB}")
    Call ySendKeys(" ", 2)                          '2秒とめる
    
    Rem コピー2
    セル.Offset(0, 1).Copy
    AppActivate "ミーティングパスコードを入力"
    Call ySendKeys("^V")
    Call ySendKeys("{TAB}")
    Call ySendKeys(" ", 5)                          '5秒とめる
    
    Call ySendKeys(" ")
    
    Application.CutCopyMode = False
    
End Sub

Private Function ySendKeys(Keys As String, Optional Time As Double = 0.5, Optional Wait As Boolean = True)
    
    Call Application.SendKeys(Keys, Wait)
    Call Application.Wait([Now()] + Time / 86400)
    
End Function

セミオートログイン

VBA

Option Explicit

Sub リンク作成()
    
    Dim i As Long
    
    For i = 3 To Cells(Rows.Count, 2).End(xlUp).Row
        Hyperlinks.Add anchor:=Cells(i, 3), Address:="", SubAddress:="", TextToDisplay:="実行"
    Next
    
End Sub

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
    
    Dim ジャンル As String
    ジャンル = Target.Range.Offset(0, 1).Value
    
    Dim 最初のセル As Range
    Set 最初のセル = Target.Range.Offset(0, 2)
    
    Select Case ジャンル
        Case "フォルダ"
            Call フォルダ(最初のセル)
        Case "Zoom"
            Call Zoom(最初のセル)
    End Select
    
End Sub

Sub フォルダ(ByVal セル As Range)
    
    Rem コピー1
    セル.Copy
    AppActivate "エクスプローラ":                   Application.Wait [Now() + "00:00:00.5"]         '0.5秒とめる
    Application.SendKeys "^V", True:                Application.Wait [Now() + "00:00:00.5"]         '0.5秒とめる
    Application.SendKeys "{TAB}", True:             Application.Wait [Now() + "00:00:00.5"]         '0.5秒とめる
    
    Rem コピー2
    セル.Offset(0, 1).Copy
    Application.SendKeys "^V", True:                Application.Wait [Now() + "00:00:00.5"]         '0.5秒とめる
    Application.SendKeys " ", True:                 Application.Wait [Now() + "00:00:00.5"]         '0.5秒とめる
    Application.SendKeys "{TAB}", True:             Application.Wait [Now() + "00:00:00.5"]         '0.5秒とめる
    Application.SendKeys "{ENTER}", True
    
    Application.CutCopyMode = False
    
End Sub

Sub Zoom(ByVal セル As Range)
    
    Rem コピー1
    セル.Copy
    AppActivate "Zoom":                             Application.Wait [Now() + "00:00:00.5"]         '0.5秒とめる
    Application.SendKeys "^V", True:                Application.Wait [Now() + "00:00:00.5"]         '0.5秒とめる
    Application.SendKeys "{TAB}", True:             Application.Wait [Now() + "00:00:00.5"]         '0.5秒とめる
    Application.SendKeys "{TAB}", True:             Application.Wait [Now() + "00:00:00.5"]         '0.5秒とめる
    Application.SendKeys "{TAB}", True:             Application.Wait [Now() + "00:00:00.5"]         '0.5秒とめる
    Application.SendKeys "{TAB}", True:             Application.Wait [Now() + "00:00:00.5"]         '0.5秒とめる
    Application.SendKeys " ", True:                 Application.Wait [Now() + "00:00:00.5"]         '0.5秒とめる
    Application.SendKeys "{TAB}", True:             Application.Wait [Now() + "00:00:00.5"]         '0.5秒とめる
    Application.SendKeys " ", True:                 Application.Wait [Now() + "00:00:00.5"]         '0.5秒とめる
    
    Application.Wait [Now() + "00:00:02"]           '2秒とめる(PW画面に移るまで時間かかるため)
    
    Rem コピー2
    セル.Offset(0, 1).Copy
    AppActivate "ミーティングパスコードを入力":     Application.Wait [Now() + "00:00:00.5"]         '0.5秒とめる
    Application.SendKeys "^V", True:                Application.Wait [Now() + "00:00:00.5"]         '0.5秒とめる
    Application.SendKeys "{TAB}", True:             Application.Wait [Now() + "00:00:00.5"]         '0.5秒とめる
    Application.SendKeys " ", True:                 Application.Wait [Now() + "00:00:00.5"]         '0.5秒とめる
    
    Application.Wait [Now() + "00:00:05"]           '5秒とめる(接続に時間がかかるため)
    
    Application.SendKeys " ", True
    
    Application.CutCopyMode = False
    
End Sub

No title

Python

import gspread
from oauth2client.service_account import ServiceAccountCredentials
import asyncio
import gspread_asyncio

scope = ['https://spreadsheets.google.com/feeds','https://www.googleapis.com/auth/drive']
credentials = ServiceAccountCredentials.from_json_keyfile_name('spreadsheet-sample.json', scope)
gc = gspread.authorize(credentials)

# 「キー」でワークブックを取得
SPREADSHEET_KEY = '15IFIuwiVy08hvNI4cdxfJK-D61S8AWvPcPxZhpon3c0'
wb = gc.open_by_key(SPREADSHEET_KEY)
ws = wb.sheet1  # 一番左の「シート1」を取得


#===ここからスクレイピング用コード===
import requests
import bs4
import pandas as pd
import codecs
from urllib.parse import urljoin
from urllib.parse import urlparse
import urllib.request, urllib.error
import time
import itertools

i = 0
while True:
    try:
        print(str(i+1)+'ページ目')
        url = 'https://haken.rikunabi.com/h/r/HS1B070n.jsp?g=W&shokushu_Cd=0342&kinmuchi_Cd=27152%2C27153%2C27104%2C27106%2C27107%2C27158%2C27159%2C27161%2C27113%2C27114%2C27115%2C27116%2C27117%2C27118%2C27119%2C27120%2C27121%2C27122%2C27123%2C27124%2C27125%2C27126%2C27127%2C27128&totalCount=135&targetPage=1&search_Area_Kbn=W&return_Kbn=1&cmd=PREV&pageNo='+str(i)
        res = requests.get(url)
        res.raise_for_status()
        soup = bs4.BeautifulSoup(res.content, 'html.parser')

        titles = []
        for title in soup.select('.ttl_cst a'):
            t = title.get_text(strip=True)
            titles.append(t)

        comps = []
        for comp in soup.select('.txt_company_data a'):
            c = comp.get_text(strip=True)
            comps.append(c)

        gs_list = []
        for t in range(len(titles)):
            lists = []
            lists.append(titles[t])
            lists.append(comps[t])
            gs_list.append(lists)
        time.sleep(3)

        for row_datas in gs_list:
            ws.append_row(row_datas)
            print(row_datas)

        time.sleep(30)

        i+=1

    except requests.exceptions.HTTPError:
       print('次ページなし')
       break

No title

Python

print("てすと")

コピー＆リネーム

VBA

Option Explicit
Const フォルダパスの行数 = 3
Const 元の列数 = 2
Const コピー先の列数 = 3
Const 最初の行 = 6

Sub リネーム()
    
    Dim ws作業シート As Worksheet
    Set ws作業シート = ThisWorkbook.ActiveSheet
    
    Rem コピー先の指定がなければフォルダを作成
    If ws作業シート.Cells(フォルダパスの行数, コピー先の列数) = "" Then
        MkDir ws作業シート.Cells(フォルダパスの行数, 元の列数) & "\リネーム後"
        ws作業シート.Cells(フォルダパスの行数, コピー先の列数) = ws作業シート.Cells(フォルダパスの行数, 元の列数) & "\リネーム後"
    End If
    
    Dim 最後の行 As Long
    最後の行 = ws作業シート.Cells(Rows.Count, 元の列数).End(xlUp).Row
    
    Rem コピー＆リネーム
    Dim f As Long
    For f = 最初の行 To 最後の行
        FileCopy ws作業シート.Cells(フォルダパスの行数, 元の列数).Value & "\" & ws作業シート.Cells(f, 元の列数).Value, _
                 ws作業シート.Cells(フォルダパスの行数, コピー先の列数).Value & "\" & ws作業シート.Cells(f, コピー先の列数).Value
    Next
    
    MsgBox "コピー＆リネーム完了！"
    
End Sub

ブックシートの保護と解除

VBA

Sub 全シートの保護と解除()
    
選択:
    
    Rem 保護の設定・解除の選択
    Dim 選択 As Long
    選択 = Application.InputBox(Prompt:="処理を選択してください" & vbCrLf & vbCrLf & "　1 = 保護   2 = 解除   0 = キャンセル", Type:=1)
    
    Rem キャンセルと再選択
    If 選択 = False Then GoTo キャンセル処理
    If Not (選択 = 1 Or 選択 = 2) Then
        MsgBox "1 か 2 を入力してください"
        GoTo 選択
    End If
    
    Rem パスワードの入力
    Dim GetPW As String
    Select Case 選択
        Case 1
            GetPW = Application.InputBox(Prompt:="保護パスワードを入力してください", Type:=2)
            If GetPW = False Then GoTo キャンセル処理
            Call 保護(GetPW)
        Case 2
            GetPW = Application.InputBox(Prompt:="解除パスワードを入力してください", Type:=2)
            If GetPW = False Then GoTo キャンセル処理
            Call 保護解除(GetPW)
    End Select
    
    Exit Sub
    
キャンセル処理:
    MsgBox "キャンセルしました"
    
End Sub

Sub 保護(ByVal PW As String)
    
    Rem シートの保護
    Dim ws As Worksheet
    For Each ws In Worksheets
        ws.Protect Password:=PW, UserInterfaceOnly:=True     'マクロでの操作は許可
    Next
    
    Rem ブックの保護
    ActiveWorkbook.Protect Password:=PW, Structure:=True, Windows:=False
    
End Sub

Sub 保護解除(ByVal PW As String)
    
    Rem シートの保護解除
    Dim ws As Worksheet
    For Each ws In Worksheets
        ws.Unprotect Password:=PW
    Next
    
    Rem ブックの保護解除
    ActiveWorkbook.Unprotect Password:=PW
    
End Sub

ブックとシートの保護

VBA

Sub 全シートの保護と解除()
    
    On Error GoTo キャンセル処理
    
    Rem 保護の設定・解除の選択
    Dim 選択 As Long
    選択 = InputBox("処理を選択してください" & vbCrLf & vbCrLf & "保護 = 1  解除 = 2")
    
    On Error GoTo 0
    
    Rem パスワードの入力
    Dim GetPW As String
    GetPW = InputBox("パスワードを入力してください")
    
    Select Case 選択
        Case 1
            Call 保護(GetPW)
        Case 2
            Call 保護解除(GetPW)
    End Select
    
    Exit Sub
    
キャンセル処理:
    MsgBox "キャンセルしました"
    
End Sub

Sub 保護(ByVal PW As String)
    
    Rem シートの保護
    Dim ws As Worksheet
    For Each ws In Worksheets
        ws.Protect Password:=PW, UserInterfaceOnly:=True     'マクロでの操作は許可
    Next
    
    Rem ブックの保護
    ActiveWorkbook.Protect Password:=PW, Structure:=True, Windows:=False
    
End Sub

Sub 保護解除(ByVal PW As String)
    
    Rem シートの保護解除
    Dim ws As Worksheet
    For Each ws In Worksheets
        ws.Unprotect Password:=PW
    Next
    
    Rem ブックの保護解除
    ActiveWorkbook.Unprotect Password:=PW
    
End Sub

Pythonでハミング距離

Python

from scipy.spatial import distance


hamming_distance = distance.hamming(list('Python'), list('Pandas')) * len('Python')

print(hamming_distance)

No title

Python

# （1）拡張モジュールのインポート
import numpy as np                  # 配列を扱う数値計算ライブラリNumPy
import matplotlib.pyplot as plt     # グラフ描画ライブラリmatplotlib
import japanize_matplotlib          # matplotlibの日本語化

# （2）時間変数tの導入
Time = 10             # 変数tの範囲 0≦t<T（日）（250,150,150,700と値を変えてシミュレーションを行う）
n = 10*Time                 # 変数tの範囲をn等分   n=T/h=T/0.1=10*T （T=250のときはn=2500）
h = 0.1                  # 等差数列の公差:0.1 固定
t = np.arange(0,Time,h)     # 0から公差dtでTを超えない範囲で等差数列を生成 t[0],...,t[n-1] 要素数n個

# （3）SIRモデル
# 3-1パラメータ
lamda = 0           # モデルエリアの人口（人）（東京都1400万人に匹敵するエリアを想定） N=S+I+R＝一定
d=0                       #標的細胞の死亡率
beta=0.00001157                     #ウィルス粒子の侵入率
delta=3.412                     #感染細胞の死亡率
p=0.020099                         #ウィルス粒子を吐き出す数
c=3.381                        #ウィルス粒子の死亡率
# 3-2初期値
I_0 = 1                # 初期感染細胞
V_0 = 0.961            # 初期ウィルス粒子数
T_0 = 400000000        #初期標的細胞
# 3-3微分方程式
dTdt = lambda T, I, V, t : lamda-d*T-beta*T*V               # dSdt ≡ dS/dt  dSdt(S, I, R, t)
dIdt = lambda T, I, V, t : beta*T*V-delta*I       # dIdt ≡ dI/dt  dIdt(S, I, R, t)
dVdt = lambda T, I, V, t : p*I-c*V                  # dRdt ≡ dR/dt  dRdt(S ,I ,R, t)
# 3-4数値積分変数S,I,Rをリストとして生成
T = np.empty(n)          # T[0],...,T[n-1] 要素数n個
I = np.empty(n)          # I[0],...,I[n-1] 要素数n個
V = np.empty(n)          # V[0],...,R[n-1] 要素数n個
# 3-5初期値代入
T[0] = T_0
I[0] = I_0
V[0] = V_0

# （4）数値積分 4次ルンゲ-クッタ法 4th-Order Runge–Kutta Methods
for j in range(n-1):     # j=0,...,n-2 -> S[j]=S[0],...,S[n-1]（I[j],R[j]も同じ） 要素数n個
  
  
  kT1 = h * dTdt( T[j] ,I[j] ,V[j] ,t[j] )
  kI1 = h * dIdt( T[j] ,I[j] ,V[j] ,t[j] )
  kV1 = h * dVdt( T[j] ,I[j] ,V[j] ,t[j] )

  kT2 = h * dTdt( T[j] + kT1/2 ,I[j] + kI1/2 ,V[j] + kV1/2 ,t[j] + h/2 )
  kI2 = h * dIdt( T[j] + kT1/2 ,I[j] + kI1/2 ,V[j] + kV1/2 ,t[j] + h/2 )
  kV2 = h * dVdt( T[j] + kT1/2 ,I[j] + kI1/2 ,V[j] + kV1/2 ,t[j] + h/2 )

  kT3 = h * dTdt( T[j] + kT2/2 ,I[j] + kI2/2 ,V[j] + kV2/2, t[j] + h/2 )
  kI3 = h * dIdt( T[j] + kT2/2 ,I[j] + kI2/2 ,V[j] + kV2/2, t[j] + h/2 )
  kV3 = h * dVdt( T[j] + kT2/2 ,I[j] + kI2/2 ,V[j] + kV2/2, t[j] + h/2 )

  kT4 = h * dTdt( T[j] + kT3 ,I[j] + kI3 ,V[j] + kV3 ,t[j] + h )
  kI4 = h * dIdt( T[j] + kT3 ,I[j] + kI3 ,V[j] + kV3 ,t[j] + h )
  kV4 = h * dVdt( T[j] + kT3 ,I[j] + kI3 ,V[j] + kV3 ,t[j] + h )

  T[j+1] = T[j] + 1/6 * ( kT1 + 2*kT2 + 2*kT3 + kT4 )   # 末項 j=n-2 -> S[j+1]=S[n-1]
  I[j+1] = I[j] + 1/6 * ( kI1 + 2*kI2 + 2*kI3 + kI4 )   # 末項 j=n-2 -> I[j+1]=I[n-1]
  V[j+1] = V[j] + 1/6 * ( kV1 + 2*kV2 + 2*kV3 + kV4 )   # 末項 j=n-2 -> R[j+1]=R[n-1]

# （5）結果表示 データプロットによるグラフ表示
# 点(t,S),点(t,I),点(t,R) それぞれ要素数n個のプロット
plt.plot(t, T, color = "green", label = "T:標的細胞", linewidth = 1.0)
plt.plot(t, I, color = "red", label = "I:感染細胞", linewidth = 1.0)
plt.plot(t, V, color= "blue", label = "V:ウィルス粒子数", linewidth = 1.0)
# グラフの見た目設定
#plt.title('SIRモデル RK4によるシミュレーション（m={},T={}）'.format(m,T))  # グラフタイトル パラメータmとTの値表示
#plt.yticks(np.arange(0,N+0.1,N/10))    # y軸 目盛りの配分 0からN（=1000万）までを10等分 N/10（=100万）刻み Nを含めるためNをN+0.1としておく
#plt.gca().set_yticklabels(['{:.0f}%'.format(y/(N/100)) for y in plt.gca().get_yticks()])   # y軸目盛りを％表示に変更
plt.xlabel('時間')                              # 横軸ラベル
plt.ylabel('数（総数に対する割合）')      # 縦軸ラベル
#plt.grid(True)                                        # グリッド表示
#plt.legend()                                          # 凡例表示
# 設定反映しプロット描画
plt.yscale('log')
plt.show()

処理時間の計測

VBA

Sub 処理時間計測()
    
    Rem 計測開始
    Dim 開始時間 As Single
    開始時間 = Timer
    
    Rem 計測終了
    Dim 終了時間 As Single
    終了時間 = Timer
    
    MsgBox "完了！" & vbCrLf & vbCrLf & "処理時間：" & Round(終了時間 - 開始時間, 2) & "秒"
    
End Sub

123 4 5 6…323 324