vbaブレークポイント（breakpoint）で止まらない場合の対処方法

vbaブレークポイント（breakpoint）で止まらない場合の対処方法
ソースコードに行数を変化させて保存して、再開すると有効らしい。

chromeのurl auto completeで特定のurlを削除する方法

1.アドレス欄に何を打って、削除したいURLのauto complete一覧を呼び出し
2.矢印で削除したいURLを選択
3.Shift+Delで削除する
以上

vba querytable csv取り込み 文字コード対応 TextFilePlatform

TextFilePlatform = 932 # SJIS 932, EUC-JP 20932, UTF8 65001, ASCII 1252

switch all comments show/hide by dblClick a cell

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Address = "$A$1" Then
        If Target.Value = "on" Then
            Target.Value = ""
            Application.DisplayCommentIndicator = xlCommentIndicatorOnly
        Else
            Application.DisplayCommentIndicator = xlCommentAndIndicator
            Target.Value = "on"
        End If
        Cancel = True
    End If
End Sub

ruby date 比較


$ irb
irb(main):001:0> require 'date'
=> true
irb(main):002:0> from = Date::strptime('2013-01-01', '%Y-%m-%d')
=> #
irb(main):004:0> to = Date::strptime('2013-01-02', '%Y-%m-%d')
=> #
irb(main):005:0> same = Date::strptime('2013-01-02', '%Y-%m-%d')
=> #
irb(main):006:0> from > to
=> false
irb(main):007:0> from < to => true
irb(main):008:0> to == same
=> true


rubyでFTPからCSV(?)をゲットして、DBに突っ込む

ftp.yml

remote_path: pub/test
retry: 3
host: 192.168.1.70
username: anonymous
password: anonymous


get_ftp.rb
sample usage: # ruby get_ftp.rb index_hist
will get 'index_hist.gz' from ftp and gunzip it to index_hist

require 'net/ftp'
require 'yaml'
cnt_retry = 0
puts "start process..."
begin
  ftp_cfg = YAML.load_file("ftp.yml")
  fn = ARGV[0]

  ftp = Net::FTP.open(ftp_cfg["host"])
  ftp.login(ftp_cfg["username"],ftp_cfg["password"])
  ftp.chdir(ftp_cfg["remote_path"])
  puts "getting #{fn}.gz from FTP for attempt #{cnt_retry}..."
  ftp.getbinaryfile("#{fn}.gz")
  system("gunzip -f #{fn}.gz")
  ftp.close
rescue => err
  if cnt_retry + 1 < 3
    cnt_retry += 1
    sleep 5
    retry
  else
    raise err
    log.error "There was an error: #{err.message}"
  end
else
  puts "Job done."
end

import to a mysql database db.yml host: 192.168.1.70
username: kagen
password: kagen
database: db_development import_indices.rb
sample usage1: # ruby import_indices.rb master index_master
will import data from index_master into table 'indices'
sample usage2: # ruby import_indices.rb hist index_hist
will import data from index_hist into table 'index_value_hist'

require 'yaml'
require 'kconv'
require 'mysql'
puts "start process of data import..."
begin
  my = Mysql::init()
  db_cfg = YAML.load_file("db.yml")
  if ARGV[0] == "master"
    tbl = "indices"
    fld = "(itemcode, jpname, engname, jpsourcename, engunitname, unit, decimalpoint, startmonth, updated_at)"
  else
    tbl = "index_value_hist"
    fld = "(itemcode, subcode, cycle, yyyy, mm, dd, val, updated_at)"
  end
  puts "Connecting to host #{db_cfg["host"]} with user #{db_cfg["username"]} using database #{db_cfg["database"]}..."
  my.real_connect(db_cfg["host"], db_cfg["username"], db_cfg["password"], db_cfg["database"])
  puts "Connected Successfully"
  my.query("SET AUTOCOMMIT=0")
  puts "Start transaction..."
  my.query("START TRANSACTION")
  if ARGV[0] == "master"
    puts "Processing Index master"
  elsif ARGV[0] == "hist"
    puts "Processing Index values history"
  end

  begin
    File.open(ARGV[1]) do |f|
      f.each_line do |row|
        sql = nil
        rows = row.split(":")
        #puts rows.inspect
        if ARGV[0] == "master"
          sql = "INSERT INTO #{tbl} #{fld} VALUES('#{rows[0]}', '#{rows[1].toutf8}', '#{rows[2]}', '#{rows[3].toutf8}', '#{rows[4].toutf8}', '#{rows[5]}', '#{rows[6]}', '#{rows[7]}', CURRENT_TIMESTAMP)"
        elsif ARGV[0] == "hist"
          if rows[3] == "D"
            if rows[0].strip == "DEL"
              sql = "DELETE FROM #{tbl} WHERE itemcode = '#{rows[1].strip}' AND subcode = '#{rows[2].strip}' AND cycle = 'D' AND yyyy = '#{rows[4][0..3]}' AND mm = '#{rows[4][4..5]}' AND dd = '#{rows[4][6..7]}'"
            elsif rows[0].strip == "UPD"
              sql = "INSERT INTO #{tbl} #{fld} VALUES('#{rows[1].strip}', '#{rows[2].strip}', 'D', '#{rows[4][0..3]}', '#{rows[4][4..5]}', '#{rows[4][6..7]}', '#{rows[5]}', CURRENT_TIMESTAMP)"
            end
          elsif rows[3] == "M"
            if rows[0].strip == "DEL"
              sql = "DELETE FROM #{tbl} WHERE itemcode = '#{rows[1].strip}' AND subcode = '#{rows[2].strip}' AND cycle = 'D' AND yyyy = '#{rows[4][0..3]}' AND mm = '#{rows[4][4..5]}'"
            elsif rows[0].strip == "UPD"
              sql = "INSERT INTO #{tbl} #{fld} VALUES('#{rows[1].strip}', '#{rows[2].strip}', 'M', '#{rows[4][0..3]}', '#{rows[4][4..5]}', '', '#{rows[5]}', CURRENT_TIMESTAMP)"
            end
          end
        end
        if sql
          #puts sql
          my.query(sql)
        end
      end
    end
    my.query("COMMIT")
  rescue => err
    puts "rollback changes..."
    my.query("ROLLBACK")
    raise err
    log.error "There was an error while insert db: #{err.message}"
  end
rescue => err
  raise err
  log.error "There was an error: #{err.message}"
else
  puts "Job done."
end

create tabless CREATE TABLE `indices` (
`itemcode` varchar(15) NOT NULL ,
`jpname` varchar(30) NOT NULL ,
`engname` varchar(28) NOT NULL ,
`jpsourcename` varchar(32) NOT NULL ,
`jpunitname` varchar(30) NOT NULL ,
`engunitname` varchar(30) NOT NULL ,
`unit` int(8) NOT NULL ,
`decimalpoint` int(8) NOT NULL ,
`startmonth` int(8) NOT NULL ,
`updated_at` datetime NOT NULL ,
PRIMARY KEY (`itemcode`)
) type=InnoDB;
CREATE TABLE `index_value_hist` (
`itemcode` varchar(15) NOT NULL ,
`subcode` varchar(5) NOT NULL ,
`cycle` varchar(1) NOT NULL ,
`yyyy` varchar(4) NOT NULL ,
`mm` varchar(2) NOT NULL ,
`dd` varchar(2) NOT NULL ,
`val` double(24,7) NOT NULL ,
`updated_at` date NOT NULL ,
PRIMARY KEY (`itemcode`, `subcode`, `cycle`, `yyyy`, `mm`, `dd`)
) type=InnoDB;
Sample Data to import (EUC, LF) No title row ☆index_value_hist only☆ UPD :AREGEN :A :M:201212:150463.7400000:20121218
UPD :AREGEN :C :M:201212:158030.9800000:20121218
UPD :AREGEN :C :W:2012124:158030.9800000:20121218
UPD :AREGEN :H :M:201212:158030.9800000:20121218
...

vbaで動的に入力規則をつける書き方

With gPlanSt.Range(RG_BASE).Resize(5, 1).Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
    xlBetween, Formula1:=Join(gShopSetting.Item(gShop).Item("曜日").Keys, ",")
    .IgnoreBlank = False
    .InCellDropdown = True
    .IMEMode = xlIMEModeAlpha
    .ShowInput = True
    .ShowError = True
End With

vbaの日付型の初期値

Office2007ですが

Dim j As Date
Debug.Print Format(j, "yyyy-mm-dd-hh-nn-ss")


1899-12-30-00-00-00

なんでこの日だろう、ちなみに「j=0」この判断も成立しますね、vbは穴だらけだね？

Dim j As Date
If j = 0 Then Debug.Print CDate(j) '0:00:00 

'おまけ、イミディエイトウィンドウで


?isdate(0)
False

?cdate(0)
0:00:00

?isdate(1)
False

?cdate(1)
1899/12/31

?cdate(2)
1900/01/01


Scripting.Dictionary に配列をValueとして置く

Sub nn()
Dim kk(2) As String
kk(0) = "aa"
kk(1) = "bb"
kk(2) = "cc"

Dim ak As New Scripting.Dictionary

ak.Add "yoro", kk

Debug.Print (ak.Item("yoro")(0))
Debug.Print (ak.Item("yoro")(1))
Debug.Print (ak.Item("yoro")(2))

kk(0) = "dd"
kk(1) = "ee"
kk(2) = "ff"

Debug.Print (ak.Item("yoro")(0))
Debug.Print (ak.Item("yoro")(1))
Debug.Print (ak.Item("yoro")(2))

End Sub

outputは：

aa
bb
cc
aa
bb
cc


その他方法

'OK1
ak.Add "yoro", array("aa","bb","cc")

'OK2
ak.Add "yoro", New Collection
ak.Item("yoro").Add "aa"
ak.Item("yoro").Add "bb"
ak.Item("yoro").Add "cc"
Debug.Print ak.Item("yoro").Count
Debug.Print ak.Item("yoro").Item(1)
Debug.Print ak.Item("yoro").Item(2)
Debug.Print ak.Item("yoro").Item(3)

'NG1
dim kk() as String
ak.Add "yoro",kk
ReDim Preserve ak.Item("yoro")(0)

'NG2
ak.Add "yoro",Array()

長時間処理時の大体のバターン、再利用のためメモした、高速化、画面更新停止、再計算停止

Dim startTime As Date
Dim usedTime As Long
startTime = Now()

Application.Calculation = xlCalculationManual 'これは必要に応じで
Application.ScreenUpdating = False

for each item in items
    DoEvents
    'do things
next

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic 'これは必要に応じで
Application.Calculate

usedTime = DateDiff("s", startTime, Now())
MsgBox "完了しました。" & vbNewLine & vbNewLine & "経過時間：" & usedTime & "秒", vbInformation + vbOKOnly, "処理結果"

svnサーバリポジトリURL変更時、コマンドラインでsvn switch relocateの例


旧URL:http://svn.myproj.com
新URL:https://svn.myproj.com

まずはinfoを見てみる
svn info

そしてURLを変更
svn switch --relocate --username kagen88 http://svn.myproj.com https://svn.myproj.com
passwordをいれて完了

確認
svn info
svn up


web pageをゲットの2種方法 xmlhttp と querytables、querytablesの取得完了を待ってから処理する

Public oXMLHTTP As New MSXML2.xmlhttp

Public Function ShowHTML(ByVal strURL, Optional ByVal strName = "") As String
    On Error GoTo ErrorHandler
    Dim strError As String
    strError = ""
    Dim strResponse As String
    strResponse = ""

    With oXMLHTTP
        .Open "GET", strURL, False
        .send ""
        If .Status <> 200 Then
            strError = .statusText
            GoTo CleanUpAndExit
        Else
                If strName <> "" Then
                    Dim outtext As Long
                    outtext = FreeFile
                    Open ActiveWorkbook.Path & "\" & strName & ".txt" For Output As #outtext
                    Write #outtext, .responseText
                    Close #outtext
                End If
                strResponse = .responseText
        End If
    End With
CleanUpAndExit:
    On Error Resume Next ' Avoid recursive call to error handler
    ' Clean up code goes here
    Set oXMLHTTP = Nothing
    ' Report any error
    If Len(strError) > 0 Then
        MsgBox strError
    Else
        ShowHTML = strResponse
    End If
    Exit Function
ErrorHandler:
    strError = Err.Description
    Resume CleanUpAndExit
End Function

Sub test1()
    repstr = ShowHTML("http://kagen88.blogspot.jp/")
    ActiveSheet.Range("A1") = repstr
End Sub

Sub test2()
Set shFirstQtr = Workbooks(1).Worksheets(1)
Set qtQtrResults = shFirstQtr.QueryTables _
 .Add(Connection:="URL;http://kagen88.blogspot.jp/", _
 Destination:=shFirstQtr.Cells(1, 1))
    With qtQtrResults
        '.WebFormatting = xlAll
        .WebFormatting = xlWebFormattingAll
        .Refresh
    End With

Dim timeToRun As Date
timeToRun = Now + TimeValue("0:00:05")
Application.OnTime timeToRun, "doSomething" '5秒を待って "doSomething"を実行
End Sub
Sub doSomething()
   'Do Anything
End Sub

egrepで複数行を探すサンプル


cat sometext.txt | egrep 'apple|banana|grape'


ExcelのDATE関数で「日」で「ゼロ」を入れると、前月の最終日が帰ってくる

Excelの数式「=DATE(年,月,日)」の「日」で「ゼロ」を入れると、前月の最終日が帰ってくる

=DATE(2013,2,0)

値は 2013/1/31で帰ってくる
え？裏ワザ？

vbaではNullの比較

vbaではNullの比較は絶対直接「=」しないで、(常識？）

abc = Null →　☓
IsNull(abc) →　○


コマンドラインでyoutubeに動画をアップロード

googleclを使いますて、youtubeに動画をアップロードする

http://code.google.com/p/googlecl/
まずはダウンロードしてください。
windowsのコマンドプロンプトで使うならgooglecl-win32-X.X.XX.zipみたな最新バージョン。
http://code.google.com/p/googlecl/downloads/list
適当に解凍してください。
そして一回目のトライ
※一回目ではコマンドを実行したら、ブラウザーが勝手に立ち上げて、googleclからyoutubeサービスにアクセスを許可するって画面が出てくる、「はい」

C:\googlecl>google youtube post c:\googlecl\abc.wmv
Please specify category:
Loading c:\googlecl\abc.wmv
{'status': 400, 'body': "<?xml version='1.0' encoding='UTF-8'?><errors><error><domain>yt:validation</domain><code>required</code><location type='xpath'>media:group/media:category[@scheme='http://gdata.youtube.com/schemas/2007/categories.cat']/text()</location></error></errors>", 'reason': 'Bad Request'}

怒られた、errorのjsonを見ると、カテゴリの省略できないだね、はいはい。

C:\googlecl>google youtube post c:\googlecl\abc.wmv
Please specify category: Howto
Loading c:\googlecl\abc.wmv
Video uploaded: https://www.youtube.com/watch?v=xxxxvideoid&feature=youtube_gdata

出来ました

I am superuser


mysql> CREATE USER 'kagen'@'%' IDENTIFIED BY 'kagen';
GRANT ALL PRIVILEGES ON *.* TO 'kagen'@'%';


買った中華パッドにGoogleTalkがないから、困った。
この「com.google.android.talk_142101.apk」を「RootExperor」で/system/appに入れれば済むみたい。

vbaでhtmlの中身を取り出す

Sub test()

    Set sht = Sheets("Sheet1")
    RowCount = 1

    Set objIE = CreateObject("internetexplorer.application")
    With objIE
        .Visible = False
        .navigate "http://www.vbapro.info"
        Do While .Busy Or .readyState <> 4
            DoEvents
        Loop
        For Each ele In .document.all
            Select Case ele.tagName
                Case "DIV":
                    sht.Range("A" & RowCount) = ele.innertext
                    RowCount = RowCount + 1
            End Select
        Next ele
    End With
    Set objIE = Nothing
End Sub