しんや@Wiki

庭のビオトープ作り

2013-07-14T12:06:31+09:00

*庭のビオトープ作りあこがれのビオトープ作りの覚書。 ▼まずは、穴掘り。大きさは1.5㎡最深部で深さ60センチ。このへんの土地は粘土質で手掘りだと一苦労。 #image(2013-07-13 06.50.40.jpg) ▼次に、アンダーライナーを敷く。ブルーシートと、タイルカーペットで木の根や石ころでプールライナーに穴があかないように保護する。 #image(2013-07-13 07.09.49.jpg) ▼次に、プールライナーを敷く。余裕をみて、穴の大きさの約２倍の大きさのプールライナーを使った。 #image(2013-07-13 07.27.35.jpg) ▼次に、小石を、底床材を敷く。真ん中のくぼみに小石を置いて、周りには、アクアリウム用のマスターソイルを使った。 #image(2013-07-13 07.44.16.jpg) #image(2013-07-13 07.44.31.jpg) ▼循環ポンプ。エーハイムのコンパクトポンプ２０００を使用。小型ながら２０００L／時間のハイパワー。 #image(2013-07-13 06.50.53.jpg) ▼あとは、レンガなどで、池の周りの装飾。 #image(http://cdn29.atwikiimg.com/coraljapan/?cmd=upload&act=open&page=%E5%BA%AD%E3%81%AE%E3%83%93%E3%82%AA%E3%83%88%E3%83%BC%E3%83%97%E4%BD%9C%E3%82%8A&file=2013-07-13%2015.45.10.jpg) ----

窓から見える飯縄山（2010秋）

2010-11-10T16:42:38+09:00

*窓から見える飯縄山（2010秋）（DOCOMO Xperia Camera360Pro ＨＤＲモード撮影 Photoshopで合成） #image(aki.jpg) ---- **あと、最近やった庭整備 ▼２階の窓から。中央の黄色い葉っぱの木はナンジャモンジャの木（正式名はヒトツバタゴ）。 #image(jyoukuu.jpg) ▼花壇　レンガ100個くらいをホームセンターで１個７８円で購入。目見当で並べた。 #image(kadan1.jpg) #image(kadan2.jpg) #image(kadan3.jpg) #image(kadan4.jpg) ▼もぐらが掘った穴。 #image(mogura.jpg) ----

窓から見える飯縄山

2010-08-10T11:24:26+09:00

*窓から見える飯縄山 DOCOMO Xperia　Camera360Pro　ＨＤＲモード撮影。 #image(C360_2010-08-10 05-24-19.jpg) ---- **あと、最近やった庭整備 ▼砂利敷き（暑い時間を避けて休日のAM６時より作業。ネットで注文して２ｔ車２台分配達してもらった。） #image(zentai.jpg) ▼「ヒメイワダレソウ」生育が早く、あっというまに緑のじゅうたんができるらいい！？（しかし、夏場の暑いときに植えるのはどうか。） #image(iwadaresou.gif) ▼黒竹（小布施のフローラルガーデンでみつけた黒竹。鉢のまんま植えちゃってるよ！） #image(kurotake.jpg) ▼花桃（ずっと梅の実かと思ってたら、桃の実だったかよ！） #image(momo.jpg) ▼いちおう遊歩道（けっこう気に入っている。） #image(yuuhodou.jpg) ▼階段（低コストで自作→　杭＝１本35円　丸太棒＝１本158円　防腐剤＝1,500円） #image(kaidan.jpg) ▼ベンチと桜の木 #image(benchi.jpg) ----

EXCEL覚え書き

2010-07-28T10:07:59+09:00

&update(j); *EXCEL覚え書き #contents() ---- **クリックしたセルの色を変更する（シート内のModuleに） Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) ActiveSheet.Rows.Interior.ColorIndex = xlNone Rows(Target.Row).Interior.ColorIndex = 15 End Sub （指定した行のみ動作させる） Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) If ActiveCell.Row < 4 Then Exit Sub ActiveSheet.Rows("4:104").Interior.ColorIndex = xlNone Rows(Target.Row).Interior.ColorIndex = 15 End Sub ---- **スクロール位置を先頭に戻す ActiveWindow.ScrollColumn = 1 ActiveWindow.ScrollRow = 1 ---- **印刷範囲を可変設定にする 1.メニュー＞挿入＞名前＞定義＞を選択する。 2.名前定義ダイアログで、Print_Areaを選択する。 3.参照範囲に「=OFFSET($A$1,0,0,COUNTA($A:$A),100)」を入力する。 A列のデータ行の数によって、印刷範囲が可変する。【OFFSET関数】OFFSET(基準, 行数, 列数, 高さ, 幅) ---- **相対パスで指定する変数 = ThisWorkbook.Path Workbooks.Open (変数 & "\..\test.xls") ---- **ボタンの行位置を知る bt = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Row ---- **自分自身を削除する。 Sub test() With ThisWorkbook .Save .ChangeFileAccess Mode:=xlReadOnly Kill .FullName .Close (False) End With End Sub ---- **フォルダ内のexcelファイルを検索する（サブフォルダも検索） Sub test() 'フォルダを検索してxlsファイル特定する Dim f, buf As String, cnt As Long, FSO Set FSO = CreateObject("Scripting.FileSystemObject") With Application.FileSearch .NewSearch .Filename = "*.xls" ''ファイル名 .LookIn = "D:\data" ''フォルダ名 .SearchSubFolders = True ''サブフォルダも検索する If .Execute() > 0 Then For Each f In .FoundFiles path_name = FSO.GetFile(f).ParentFolder ''パス file_name = FSO.GetFile(f).Name ''ファイル名 MsgBox path_name & "\" & file_name Next f End If End With Set FSO = Nothing End Sub ---- **セルがエラーかどうか調べる Set rg = Range("A1") If Application.WorksheetFunction.IsError(rg) Then '処理 End If ---- **ユーザーフォームの表示位置を画面サイズの右側にする Private Sub UserForm_Activate() Me.Left = Application.Left + Application.Width - Me.Width Me.Top = Application.Top + (Application.Height - Me.Height) / 2 End Sub ---- **定期的にマクロを実行する 1秒ごとにA1に現在時刻を表示 'OnTime開始 Sub timer_start() Application.OnTime Now + TimeValue("00:00:01"), "timer_start" Range("A1") = Now() End Sub 'OnTimeキャンセル Sub timer_stop() On Error Resume Next Application.OnTime Now + TimeValue("00:00:01"), "timer_start", schedule:=False End Sub 10秒ごとに10回先まで予約 Sub test() For i = 1 To 10 Application.OnTime Now + TimeValue("00:00:10") * i, "my_Procedure" Next i End Sub Sub my_Procedure() MsgBox "きたー" End Sub ---- **ファイルダイアログでファイル名を取得する fname = Application.GetOpenFilename( _ Title:="取り込みファイルの選択") If fname = False Then Exit Sub Msgbox fname End If ---- **指定の表示形式を返す Format(Now(), "yymmdd") ---- **ファイルがあるかどうかチェックする Sub filechk strWrk= ここにパス記入 strFile=ここはファイル名 If Dir(strWrk & strFil) = "" Then MsgBox("ファイルありません") End If End Sub ---- **入力規則である条件では入力できないようにする A1がバナナか、リンゴか、みかんのときで、なおかつ、B1が食べる以外のときは入力できないようにする。データの入力規則で、設定をユーザ定義数式に、 =OR(AND(A1<>"バナナ",A1<>"リンゴ",A1<>"みかん"),B1="食べる") ---- **処理中にWAITを入れる Application.Wait [NOW()+"0:00:00.01"] 1/100秒停止 ---- **VBAでファイルコピー、移動ファイルコピー Option Explicit Private Const cnsSOUR = "C:\AAA\SAMPLE1.txt" ' 元ファイル Private Const cnsDEST = "C:\BBB\SAMPLE2.txt" ' 先ファイル ' ファイルコピーのサンプル Sub COPY_SAMPLE() ' ファイルをコピー FileCopy cnsSOUR, cnsDEST End Sub パスを含めた名前で指定する。ファイル移動（コピーして元ファイル削除） Option Explicit Private Const cnsSOUR = "C:\AAA\SAMPLE1.txt" ' 元ファイル Private Const cnsDEST = "C:\BBB\SAMPLE2.txt" ' 先ファイル ' ファイル移動のサンプル② Sub MOVE_SAMPLE2() ' ファイルをコピー FileCopy cnsSOUR, cnsDEST ' 元ファイルを削除 Kill cnsSOUR End Sub ---- **VBAでホームページを開く Sub Sample() Shell "EXPLORER.EXE http://google.co.jp/" End Sub ---- **ユーザーフォームのTextBox1にセットする UserForm1.TextBox1 = "てきすと" ---- **ユーザーフォームと変数をやり取りする標準モジュールの先頭に、呼出し元のプロシージャとユーザフォームで共用したい変数名をPublicでセットします。 ---- Public aaa, bbb ---- Sub test() aaa = 3000 UserForm1.Show vbModeless MsgBox bbb End Sub ---- Private Sub UserForm_Initialize() TextBox1.Text = aaa bbb = 500 End Sub ---- **他のブックのマクロを実行する Application.Run "book1.xls!test" ※引数を渡す場合は、 Application.Run "'book1.xls'!test",aaa,bbb 例）元ブック Workbooks.Open Filename:=("sample.xls") hiki1 = "りんご" hiki2 = "おいしい" Application.Run "sample.xls!ringo", hiki1, hiki2 先ブック Sub ringo(hiki1, hiki2) With UserForm1 .TextBox1 = hiki1 .TextBox2 = hiki2 .Show End With End Sub ---- **既存のブックをコピーする Sub bkcopy() wp = ThisWorkbook.Path Workbooks.Open Filename:=(wp & "\aaaa.xlsx"), ReadOnly:=True Application.DisplayAlerts = False Workbooks("aaaa.xlsx").Activate ActiveWorkbook.SaveAs Filename:=wp & "\bbbb.xls" Application.DisplayAlerts = True ActiveWorkbook.Close End Sub ---- **ブックを読み取り専用で開く Workbooks.Open Filename:=("BBB.xls"), ReadOnly:=True ---- **別のブックのセルの値を取得する（ユーザフォーム） Private Sub UserForm_Initialize() wp = ThisWorkbook.Path Workbooks.Open Filename:=(wp + "\aaaa"), ReadOnly:=True with Workbooks("aaaa.xlsx") msg = .Sheets(1).Range("a1") .Windows(1).Visible = True .Close End with TextBox1 = msg End Sub ---- **アクティブなブックを閉じる ActiveWorkbook.Close ---- **ブックをアクティブにする Workbooks("sample.xls).Activate ---- **ブックを保存する ActiveWorkbook.Save ---- **ブックを別名で保存する ActiveWorkbook.SaveAs "Sample.xls" ---- **他のブックのシートのセルの値を取得（リンク方式） Range("a1") = "='" & "c:\" & "[" & "サンプル.xls" & "]シート１'!" & Range("a1") ---- **他のブックのシートのセルの値を取得 Workbooks.Open Filename:=("サンプル.xls"), ReadOnly:=True Range("a1") = Workbooks("サンプル.xls").Sheets(1).Range("a1") ActiveWorkbook.Close ---- **開いているブックを見えなくする Workbooks("aaaa.xlsx").Windows(1).Visible = False ---- **指定したブックが開いているか調べる Sub Sample15() Dim wb As Workbook, flag As Boolean For Each wb In Workbooks If wb.Name = "Book1.xls" Then flag = True Next wb If flag = True Then MsgBox "開いています。" Else MsgBox "開いていません。" End If End Sub ---- **エクセルを終了する Application.Quit ---- **条件が一致したときのみ、コントロールを表示する例）ComboBox1が"あり"に選択のとき、ComboBox2を表示 Private Sub ComboBox1_Change() If ComboBox1 = "あり" Then ComboBox2.Visible = True Exit Sub End If End Sub ---- **ユーザーフォームにコンボボックスを作成する 1.ユーザーフォームにツールボックスからコンボボックスを作成する。 #image(080526_1.gif) 2.Initialize()にコンボボックスの文字列を羅列する。 Private Sub UserForm_Initialize() With ComboBox1 .AddItem "リスト１" .AddItem "リスト２" .AddItem "リスト３" .AddItem "リスト４" End With End Sub ---- **乱数を発生させるマクロ Randomize rnd1 = Int(Rnd * 99999999 + 1) ※99999999は0～99999999の乱数 ---- **ユーザーフォーム出現位置を設定する Private Sub UserForm_Initialize() Me.StartUpPosition = 0 Me.Left = 20 Me.Top = 10 End Sub ---- **覚えておくと便利なショートカットキーのことその１　現在日付を入力〔CTRL〕+〔；〕その２　現在時刻を入力〔CTRL〕+〔：〕その３　関数の引数を表示〔CTRL〕+〔SHIFT〕+〔Ａ〕たとえば、数式バーに=IFと入力してから、〔CTRL〕+〔SHIFT〕+〔Ａ〕と押すと、=IF(論理式,真の場合,偽の場合)と表示される。その４　書式のみのコピペ〔CTRL〕+〔SHIFT〕+〔Ｃ〕書式のみコピー〔CTRL〕+〔SHIFT〕+〔Ｖ〕書式のみペースト ---- **CALL ステートメントと、引数他のマクロを呼び出すときに、変数を受け渡す場合は、以下を参考。 Sub test() Call メッセージ表示("あははは") End Sub Sub メッセージ表示(moji) MsgBox moji End Sub 複数受け渡す場合は、カンマで区切って列挙する。 Sub test() Call メッセージ表示("あははは", "いひひひ", "うふふふ") End Sub Sub メッセージ表示(moji1, moji2, moji3) MsgBox moji1 MsgBox moji2 MsgBox moji3 End Sub ---- **２つのテキストファイルの比較 A.txtとB.txtを行ごとに比較します。 Sub 比較() Dim strREC_A As String Dim strREC_B As String Dim File_A As String Dim File_B As String Dim ForderPass As String Dim CT As Long ForderPass = ThisWorkbook.Path File_A = "\A.txt" File_B = "\B.txt" Open ForderPass & File_A For Input As #1 Open ForderPass & File_B For Input As #2 CT = 1 st: If EOF(1) Or EOF(2) Then GoTo owari End If Line Input #1, strREC_A Line Input #2, strREC_B If strREC_A <> strREC_B Then MsgBox CT & "行目違う。" & vbCrLf & strREC_A & vbCrLf & strREC_B End If CT = CT + 1 GoTo st owari: Close #1 Close #2 MsgBox "終了。" End Sub ---- **テキストファイルの内容をセルに読み込む　マクロ Sub READ_TextFile() Const cnsFILENAME = "\sample.txt" Dim intFF As Integer ' FreeFile値 Dim strREC As String ' 読み込んだレコード内容 Dim GYO As Long ' 収容するセルの行 ' FreeFile値の取得(以降この値で入出力する) intFF = FreeFile ' 指定ファイルをOPEN(入力モード) Open ThisWorkbook.Path & cnsFILENAME For Input As #intFF GYO = 1 ' ファイルのEOF(End of File)まで繰り返す Do Until EOF(intFF) ' 改行までをレコードとして読み込む Line Input #intFF, strREC ' 行を加算しA列にレコード内容を表示(先頭は2行目) Cells(GYO, 1).Value = strREC GYO = GYO + 1 Loop ' 指定ファイルをCLOSE Close #intFF End Sub ---- **文字列をテキストファイルへ書き出す　マクロ Sub WRITE_TextFile() Const cnsFILENAME = "\SAMPLE.txt" Dim intFF As Integer ' FreeFile値 Dim strREC As String ' 書き出すレコード内容 ' FreeFile値の取得(以降この値で入出力する) intFF = FreeFile ' 指定ファイルをOPEN(出力モード) Open ThisWorkbook.Path & cnsFILENAME For Output As #intFF ' 内容をレコードにセット strREC = "test" ' レコードを出力 Print #intFF, strREC ' 指定ファイルをCLOSE Close #intFF End Sub ---- **処理実行中のカーソルを砂時計にする Application.Cursor = xlWait 元に戻すには、 Application.Cursor = xlDefault ---- **セルの値を簡易棒グラフで表示する以下の様な表示。 #image(080218.gif ) A列にパーセンテージを入力。 B列に■で棒グラフが作成される。 B列の関数 =LEFT("■■■■■■■■■■",TRUNC($A1/0.1)) ※条件書式で、100%を赤く設定してあります。 ---- **エクセルで早口言葉？くだらなすぎ。（自爆） http://www29.atwiki.jp/coraljapan/?cmd=upload&act=open&page=EXCEL%E8%A6%9A%E3%81%88%E6%9B%B8%E3%81%8D&file=20080217_hayakuchi.xls ---- **ユーザーフォームのテキストボックス内での制御プロパティ SelLength 選択されたテキストの文字数を設定します。値の取得も可能です。 SelStart 選択されたテキストの開始点を設定します。値の取得も可能です。テキストが選択されていないときは、挿入ポインタの位置を示します。 SelText 現在選択されているテキストを含む文字列を設定します。値の取得も可能です。文字が選択されていないときは、長さ 0 の文字列 ("") を返します。例）TextBox1.SelStart = 0 カーソル位置を先頭にします。 ---- **ユーザーフォームのテキストボックス内で改行する。 EnterKeyBehaviorをTrueに設定します。 MultiLineもTrueに設定しておく必要があります。 ---- **Format関数 Format([値],"[書式設定]") 以下は書式設定カンマ区切り： #,##0 ： 1,234 ￥マーク入り： \\#,##0 ： \1,234 単位付き： #,##0\円： 1,234円小数点桁数の指定： #,##0,0000 ： 1,234.5670 小数点桁数の指定２： #,##0,0### ： 1,234.567 日付の書式： YYYY/MM/DD HH:NN:SS ： 2002/11/28 10:18:30 YYYYMMDDをYYYY/MM/DD ： @@@@/@@/@@ ： 20021128->2002/11/28 西暦を和暦： GGGEE\年MM\月DD\日： 2002/11/28->平成14年11月28日和暦を西暦： YYYY\年MM\月DD\日：平成14年11月28日->2002年11月28日数値を曜日： AAAA ： 1->日曜日四半期を返す： Q ： 2002/01->1 郵便番号： @@@-@@@@ ： 2510871->251-0871 左に0を充填： 00000 ： 123->00123 左に半角スペースを充填： @@@@@ ： 123-> 123 全部大文字： > ： abc->ABC 全部小文字： < ： ABC->abc 曜日：aaa：2003/01/30 -> 木カンマ区切りで0なら表示しない : #,### : 1234->1,234 0->(表示しない) ---- **ユーザーフォームをモードレスで表示する UserForm1.Show vbModeless vbModelessをつけると、ユーザーフォームを表示しながら、セルの選択などができます。 ---- **ユーザーフォームで簡易プログレスバーをつくる。１．Visual Basic Editerを開く。Alt+11 ２．メニューの挿入→ユーザーフォームを選択して、フォームを新規作成する。３．ツールボックスの、「ラベル」で以下のようにラベルを２つと、「コマンドボタン」でボタンを一つ作成する。 #image(20080215_1.gif) ４．作成したコマンドボタン上で右ボタンを押して、プロパティを表示して、Captionを「OK」に変更する。５．ユーザーフォームを選択した状態で、F7を押して、コードを表示する。６．表示されているコードをすべて削除して、以下のコードを入力する。 Private Sub UserForm_Activate() Label2 = "作業中です..." lb = "■" For i = 0 To 100 Label1 = lb DoEvents lb = lb + "■" 'ここから処理 For w = 1 To 10000 For x = 1 To 100 Next x Next w 'ここまで処理 Next i CommandButton1.Enabled = True Label2 = "完了しました。" End Sub Private Sub CommandButton1_Click() Unload Me End Sub ７．Visual Basic Editerを閉じる。８．新規マクロに以下を入力する。 Sub プログレス() UserForm1.Show End Sub ９.マクロ「プログレス」を実行する。 &link(完成データ){http://www29.atwiki.jp/coraljapan/?cmd=upload&act=open&page=EXCEL%E8%A6%9A%E3%81%88%E6%9B%B8%E3%81%8D&file=sample1.xls} ---- **DATEVALUE関数とTIMEVALUE関数指定された文字列からシリアル値を求めるものです。例） TIMEVALUE（"6:0:0"） DATEVALUE（"2008/2/14"） ---- **YEAR関数指定した日付の年を返します。例）YEAR(Now()) ---- **実行中のマクロを強制終了する。・Dos/V機　　　　　　　[CTRL]+[Break(Pause)] ・PC9800シリーズ　　　[CTRL]+[STOP] ---- **他のシートのセルの内容を取得する　マクロ aaa=Worksheets("Sheet1").Range("A1") ---- **シートがアクティブになったら、指定したマクロを実行する。 Sub Auto_Open() 'Sheet1がアクティブになったら「Macro1」マクロ実行 Worksheets("Sheet1").OnSheetActivate = "Macro1" End Sub ---- **曜日まで表示する表示形式設定 yyyy"年"m"月"d"日（"aaa"）" ---- **シート名一覧を取得するマクロ　その２ Sub シート一覧() ct = 1 For I = 1 To Sheets.Count shname = Sheets(I).Name Cells(ct, 1) = shname ct = ct + 1 Next End Sub ---- **データの最終行を知る　マクロ er = Range("A" & 65536).End(xlUp).Row ---- **フォルダのコピー　マクロ c:\001の内容を%temp%\書庫へコピーします。 Sub FolderCopy() Dim SourcFolderSpec, DestFolderSpec, TempFolder As String Dim SourcFolder_Object, DestFolder_Object As Object Dim FileNamePath As Variant '環境変数TEMP を取得します TempFolder = Environ("temp") 'Source Folder をセットします SourcFolderSpec = "c:\001" 'Destination Folder をセットします DestFolderSpec = TempFolder & "\書庫" 'フォルダオブジェクトを取得 Set SourcFolder_Object = CreateObject _ ("Scripting.FileSystemObject").GetFolder(SourcFolderSpec) 'SourcFolderSpec内の全ファイルをDestFolderSpecにコピー 'サブフォルダも対象になります SourcFolder_Object.Copy DestFolderSpec MsgBox "完了しました" End Sub ---- **文字列の操作 =LEFT(文字列,[文字数]) ：文字列の左端から指定した文字数だけ取り出す。　文字数を省略すると1を指定したことになります(1の時は省略できる)。 =RIGHT(文字列,[文字数]）：文字列の右端から指定した文字数だけ取り出す。文字数を省略すると1を指定したことになります(1の時は省略できる)。 =MID (文字列，開始位置,文字数) ：文字列の指定した位置から指定した文字数だけ取り出す。 =SEARCH(検索文字列,対象,開始位置) 文字列が開始位置から何番目にあるかを返します英字の大文字と小文字を区別できませんが、ワイルドカード文字を使用できます。 =FIND(検索文字列,対象,開始位置) 文字列が開始位置から何番目にあるかを返します英字の大文字と小文字を区別できる代わりに、ワイルドカード文字を使用することができません。 ---- **選択したフォルダ内のファイル一覧を取得するマクロ Sub ファイルリスト() Dim filename As String 'ファイル名 Dim DrvDir As String 'フォルダパス Dim rw As Long '行カウンタ Dim ShellApp As Object 'ShellApp Dim myFolder As Object 'フォルダ名 Set ShellApp = CreateObject("Shell.Application") Set myFolder = ShellApp.BrowseForFolder(0, "フォルダ選択", 1) If myFolder Is Nothing Then Exit Sub DrvDir = myFolder.items.Item.Path & "\" 'フォルダパスをセットする With Worksheets("Sheet1") .Range("A2:A65536").ClearContents '表示用のA列をクリア rw = 1 'フォルダを検索してファイルとフォルダを特定する filename = Dir(DrvDir & "*.*", vbDirectory) While filename <> "" '順にSheet1に書き出していく rw = rw + 1 .Range("A" & rw) = filename filename = Dir(, vbDirectory) Wend End With End Sub ---- **ブックの共有操作のマクロ Sub ブックの共有を解除() 'ブックの共有を解除 Application.DisplayAlerts = False If ActiveWorkbook.MultiUserEditing Then _ ActiveWorkbook.ExclusiveAccess End Sub Sub ブックの共有をする() 'ブックの共有をする Application.DisplayAlerts = False ActiveWorkbook.KeepChangeHistory = True ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.FullName, _ AccessMode:=xlShared End Sub ---- **メッセージボックスのアイコン vbCritical 警告メッセージアイコン vbQuestion 問い合わせメッセージアイコン vbExclamation 注意メッセージアイコン vbInformation 情報メッセージアイコン ---- **セル範囲指定で絶対的な座標で指定する INDIRECT("A1:A100")) このように設定すると、行が削除されてもA100は変化しない ---- **メッセージボックスで改行する MsgBox "これは" & vbCrLf & "ペンデス" ---- **ステータスバーに表示するマクロ Application.StatusBar = "リスト取得中です...(現在 " & rw - 3 & "件)" ---- **実行中の自動計算をオフにするマクロ Application.Calculation = xlCalculationManual オンに戻すには以下のマクロ Application.Calculation = xlCalculationAutomatic ---- **実行中の画面の更新を無効にする Application.ScreenUpdating = False 有効にするには、FalseをTrueです ---- **指定した文字列が含まれる行以外を削除するマクロ Sub 行削除() Dim Rwe As Long Dim R As Long Dim delname As String delname = InputBox("検索対象を入力してください", "検索") If delname = "" Then MsgBox "検索を中断します", vbInformation, "検索" End End If Rwe = Range("B" & 65536).End(xlUp).Row For R = Rwe To 1 Step -1 'To 1では、１行目から検索します If Application.CountIf(Rows(R), "*" & delname & "*") = 0 Then '=0 を >0にすると、検索対象がある行を削除します Rows(R).Delete End If Next MsgBox delname & " 以外を除去しました", vbInformation, "検索" End Sub ---- **24時間を越える場合のマクロでの記述 Sub 24over() RT = Int(Range("A1") * 24) & ":" & Format(Range("A1"), "nn:ss") MsgBox "経過時間は" & RT & "です。" End Sub ---- **アクティブシートの名前を変更するマクロ ActiveSheet.Name = シート名 ---- **アクティブブックのシートをコピーするマクロ Sheets("シート名").Copy シート４の後に追加コピー Sheets("シート名").Copy Before:=Sheets(4) ---- **ワークシートを別のBOOKへ保存するマクロあらかじめ、Bookと同じディレクトリに書庫というフォルダを作成しておいてください。 Sub 書庫へ保存() yesno = MsgBox("シートを保存します　よろしいですか？", vbYesNo + vbQuestion, "進捗度表") If yesno = vbNo Then End End If wpath = ThisWorkbook.Path & "\" 'パスを設定する sheetname = ActiveWorkbook.ActiveSheet.Name 'シート名を取得する datenow = Format(Now, "yyyymmdd") '日時を設定 savename = wpath & datenow & "_" & sheetname & ".xls" 'ファイル名設定 savename_msg = datenow & "_" & sheetname & ".xls" '表示用ファイル名設定 Sheets(sheetname).Copy 'シートを新規ブックへコピー ActiveWorkbook.SaveAs Filename:=savename '新規ブックを保存する ActiveWorkbook.Close '新規ブックを閉じる Application.DisplayAlerts = False '警告メッセージオフ Worksheets(sheetname).Delete Application.DisplayAlerts = True '警告メッセージオン MsgBox savename_msg & vbCrLf & "書庫へ保存しました", vbInformation, "シート保存" End Sub ---- **「はい」「いいえ」ダイアログを表示するマクロ Sub 問い合わせ() yesno = MsgBox("シートを保存します　よろしいですか？", vbYesNo + vbQuestion, "問い合わせ") If yesno = vbNo Then End End If End Sub ---- **複数条件のカウント　SUMPRODUCT関数　その２ &html(=SUMPRODUCT((A1:A10="初稿")*(MONTH(B1:B10)=3)*(ISNUMBER(FIND("出版",C1:C10))))) A1:A10が初稿で、B1:B10が3月で、C1:C10の文字列に”出版”という文字を含んでいるならカウントする（解説） ISNUMBER(セル番地または計算式）参照しているセルが数値かどうか調べる。数値なら TRUE (1) 数値でないなら FALSE (0) FIND(検索文字列,対象,開始位置) 参照しているセルの検索文字列の位置を調べる含まれない場合は#VALUEとなる。 ---- **複数条件のカウント　SUMPRODUCT関数 &html(=SUMPRODUCT((A1:A10="初稿"))*(MONTH(B1:B10)=3)) A1:A10が初稿でB1:B10が3月ならカウントする ---- **シリアル値から日付データ「年」「月」「日」を取り出す =YEAR(シリアル値) =MONTH(シリアル値) =DAY(シリアル値) ---- **範囲内の最大値、最小値を求める範囲内の最大値 =MAX(範囲) 範囲内の最小値 =MIN(範囲) 例） =MAX（A1:A5) =MIN(B1:B5) =MAX（A1:A5)-MIN(B1:B5) ---- **BOOKを開いたら、マクロを自動で実行する Sub Auto_Open() MsgBox "自動です"　　　　'ここに必要な処理を記述します End Sub ---- **ラベルへジャンプするマクロ GoTo ラベル: ラベル: 例） Sub goto001() If ActiveCell.Value = True Then GoTo msg1 End If End msg1: MsgBox "Trueですよ" End Sub ---- **アクティブセルの位置を調べるマクロ行位置 ActiveCell.Row 列位置 ActiveCell.Column ---- **シートをアクティブにするマクロ Worksheets("Sheet1").Activate ---- **ワークブックを開くマクロ Workbooks.Open Filename:=ThisWorkbook.Path & "ファイル名.xls" ---- **アクティブセルの内容を取得するマクロ bn = ActiveCell.Value ---- **指定したセルに値を代入するマクロ A5に1を代入 Cells(5,1).Value=1 ---- **指定範囲内のセルに値を代入するマクロ A1　C5の範囲に1を代入 Range("a1:c5").Value=1 ---- **シート名の一覧を表示するマクロ Sub ListSheetsName() Dim objSheet As Object Dim intLoop As Integer intLoop = 1 For Each objSheet In ActiveWorkbook.Sheets Cells(intLoop, 1).Value = objSheet.Name intLoop = intLoop + 1 Next End Sub （補足） Cells(intLoop, 1).Value = objSheet.Name を Cells(intLoop, 1).Value = objSheet.Range("A1") にすると、参照シート内のA1の内容を持ってこれる。 ---- **セルにアクティブシート名を表示する =MID(CELL("filename"),FIND("]",CELL("filename"))+1,31) ---- **重複データを削除する（A1セルにフィールド見出し、A2:A10セルに9個のデータが入力されているときに、重複データを削除した新たなリストをC列に作成する例）メニュー［データ］－［フィルタ］－［フィルタオプションの設定］をクリック　↓ ［フィルタオプションの設定］ダイアログで　［抽出先］欄で［指定した範囲］オプションボタンをOnに　［リスト範囲］欄で「A1:A10」セルを　［抽出範囲］欄で「C1」セルを　［重複するレコードは無視する］チェックボックスをOnに設定　↓ ［フィルタオプションの設定］ダイアログ－［OK］ボタンをクリック -&bold(){参考} http://pc.nikkeibp.co.jp/article/NPC/20060214/229243/ -サンプル http://www29.atwiki.jp/coraljapan/?cmd=upload&act=open&page=EXCEL%E8%A6%9A%E3%81%88%E6%9B%B8%E3%81%8D&file=%E6%8A%BD%E5%87%BA.xls ---- **条件にあったものの合計 =SUMIF(B1:B4,"りんご",C1:C4) B1~B4のりんごに該当するもののみ、C1~C4の合計を計算 ---- **クリックした図形のセルの色を変えるマクロ以下のマクロを、セル上の図形に登録する。 Sub iro001() Dim button As Range 'セル位置取得 button Set button = ActiveSheet.Shapes(Application.Caller).TopLeftCell 'セル位置　0,0の色を変更 With button.Offset(0, 0).Interior .ColorIndex = 10 .Pattern = xlSolid End With End Sub ---- **セルに時間を記録するマクロ A2が開始なら、B2に現在時刻を返す。 A2が終了なら、C2に現在時刻を返す。 Sub jikankiroku() If Range("A2").Value = "開始" Then Range("B2") = Now() End If If Range("A2").Value = "終了" Then Range("C2") = Now() End If End Sub ---- **=COUNTIF関数 =COUNTIF(A1:A10,"合格") A1～A10までのセルに「合格」が何個存在するか返す。 =COUNTIF(A1:A10,"合格")+COUNTIF(A1:A10,"不合格") とすると、合格+不合格の合計数が何個あるか返す。 ---- **条件付書式セルの内容によって、書式を変化させる。例）セルの値が”合格”なら、セルパターン＝赤色、文字色＝白 #image(jyouken.gif) ---- **IF関数 =IF(A1="","",IF(A1>50,"○","×")) A1が空白なら、空白。空白以外なら、A1>50をチェック。 50以上なら○ 50以下なら×。 ---- **セルのコピー＆貼り付けセルが別のセルを指している時にそのセルを別の位置にコピーすると、移動した分だけ指していた位置まで移動してしまう。これを移動させず、指している位置が変わらないままにするには、変えたくない行・列には「$」を前につけて、「$A$1」といった指定をする。 -&bold(){参考}http://www.ne.jp/asahi/hishidama/home/tech/excel/cellcopy.html ---- **セル内の文字列をリスト形式で選択１　［▼］を押して選択するためのリストを別の場所に作成。２　ドロップダウンリストを表示させたいセルを選択して、メニューバー［データ］から［入力規則］をクリック。３　［設定］タブの［入力値の種類］で［リスト］を選択し、［元の値］に文字カーソルを移します。４　ドロップダウンリストの元となる、欄外に入力したデータを範囲選択する。５　［ＯＫ］を押す。 -&bold(){参考}http://kokoro.kir.jp/excel/nkisoku_list.html ----

フレッツ光ネクストが早すぎる件

2010-07-15T16:59:33+09:00

*フレッツ光ネクストが早すぎる件新築と同時に光回線を敷設した。ずっとフレッツの回線速度サイトへの光電話ルーターのアクセス設定がわからなかったが、なんてことはない、Windows７のIPv6プロトコルを有効にして、フレッツ・スクウェアネクストの回線速度のページにアクセスするだけだった。（ルーターの設定は特にいじる必要なし。）フレッツ・スクウェアネクスト [[http://flets.com/next/square/index.html>http://flets.com/next/square/index.html]] ようやく速度計測ができて、計ってみると、 **早っ。 #image(sp1.png) *しかし、この数値は、 NGN（Next Generation Network）回線までの数値。 NGNより外のISPの回線は変わっていないため、普通にネットを使う分には現状では早くなっていないようだ。 ----

ミヤマハウスの家が完成するまで（私の場合）

2010-06-18T07:23:39+09:00

&update(j); &meta_keywords(輸入住宅,建築,別荘,ローコスト,不動産,新築,長野,輸入住宅,住宅ローン) ---- *ミヤマハウスの家が完成するまで（私の場合。） ---- 先日、新居が完成しました。このメモは、過去５ヶ月間の完成までの回想です **～2010年１月～ ***１．そろそろ老後の心配もあり、家を建てたいと思っている矢先、近所でミヤマハウスという会社の住宅現場見学会があり、ふらっと行ってみる。いままで、住宅見学会など、行ったことがなく、荒手の営業に丸めこまれやしないかと、かなり躊躇したが、思い気ってピンポンを押してみた。玄関に入ると、穏和な営業のおじさんが一人いた。外観からして、無知な私は３千万くらいの建物かと思ったが、聞いてみると、建物で1300万といわれ、え！安！と思う。４LDKで内部は広々し、窓が格子窓になっているなど、すぐに気に入ってしまった。冬であったため、15畳ほどのリビングには薪ストーブを模したアンティークストーブがついていた。これはサービスで、差し上げますと言われ、さらに気に入ってしまう。 >▼新築時にサービスで取り付けてもらえるアンティークストーブ（TOYOTOMI製） #image(fq-705s.jpg) *しかし、自分に新築は無理だと思い、またまた無知な私は、土地建物で１千万くらいの中古物件でないか聞いてみた。当社は不動産もやっているというので、また探しておくから次の土曜日に事務所のほうへお越しくださいと言われる。事務所の地図と、名刺をもらった。名刺をよく見たらこのおじさん、ミヤマハウスの社長なんだと知る。（ｷﾞｮ。。）このときに、１千万だと、月々の支払い額はこのくらいなど、住宅購入についての基礎知識を教えてもらった。 ***２．次の休みに事務所へ訪ねると、数件中古物件が候補として、用意されていた。ミヤマハウス社長に車であちこち案内され、車中、住宅に関する知識も教えてもらえた。社長自身の体験談で、姫川にヒスイを取りにいって、岩風呂を作ったが家族に反対され撤去した話。この話をのちに２回されたが、社長の人柄がよく現れている。案内された家だが、どれも、築30年以上で、とても検討できないものであった。これであれば、新築のほうがいいと思い、新築構想がスタートする。すぐに事務所へ電話で新築したいと意思を社長に伝えた。また次の休みに事務所へ来社下さいと言われ、それまでに、土地を数件さがしておくとの事だった。 ***３．また次の休みに訪ねると、遅刻したにもかかわらず（ほぼいつも遅刻していた・・・）、暖かい対応で出迎えてもらった。聞いたことのない地名だったが、土地の候補が数件あり、車で現地へ案内された。長野市内では、土地価格が高いため、できるだけ、安いところをさがしてもらったところ、飯綱町の福井団地に決まる。土地決めで、相当悩んだが、社長曰く、いろんな土地の価格を知っているが、希望予算だと、このくらいの物件がいいところだと言われ、ようやく決定した。 ***４．さっそく土地をおさえてもらい、銀行へ融資の仮審査を申請し、内諾の連絡をもらう。給料の振り込み先の銀行をミヤマハウス社長に言うと、すべてが手続きを進めてもらえた。資金計画の相談を社長にし、月々の支払いは現在の家賃と変わらないことを知る。いままで、アパートで家賃を払ってきたのが馬鹿に思えた。 ***５．銀行担当者への手続きは引き続きミヤマハウスに進めてもらう。融資申し込みもミヤマハウス事務所のほうで、銀行担当者を招いて手続きする。自分では、書類の用意のみで銀行のほうにはなにも連絡などしなくてよかった。 &u(){※申し込み時必要書類：源泉徴収票２年分、印鑑証明、住民票、身分証明コピー} ***６．建築図面の作成と、打ち合わせ。毎週末、事務所へ行って社長と打ち合わせを行う。１回の打ち合わせに２時間くらいかかることもある。小屋ウラを作ろうと思ったが、値段の割にあまり機能性がよくないということで断念。同じ金額なら２部屋を増設できると言われ、最終的に4LDK、１階リビングを吹き抜けで決定した。基本図面ができあがると、内装関係の打ち合わせで、コーディネータとの打ち合わせに切り替わる。コーディネータは事務所以外でも、気づいたときにいつでもメールすると、対応してもらえる。いろいろ、追加工事費用がかさみ、銀行へ融資の増額のお願いをする。これもミヤマハウスから連絡してもらえた。 ***７．土地の売買契約をする。銀行へ行き、土地の持ち主、司法書士、ミヤマハウス銀行担当者、銀行の担当者と自分で契約を行う。土地代金は、つなぎ融資で、保証人付きで一時的な借り入れをする。水道の加入手続き書類もこのときにミヤマハウスが用意してきたものにハンコを押す。土地の売買契約は、30分くらいで完了。自分の口座に数百万の土地代が融資される。喜んでいるのもつかの間、即時払出しが行われ、売り主の口座に渡る。 ***８．土地が自分の手に入り、地鎮祭をする。ミヤマハウス社長、工事責任者、自分とで20分くらいで完了。お供物、海の物、山の物を用意する。これもミヤマハウスに頼んで用意してもらった。代金は当方持ち。神主さんに、お酒、お布施１万５千円を渡す。この神主さんの儀式がかなり笑えるが、こらえなくてはならない。 ***９．基礎着工開始。現場に建築基準法の確認済み看板が立つ。当たり前だが自分の名前が入っており、かなりテンションあがる。 #image(kakuninzumi.jpg) 元々畑で、かなり荒れた土地であったが、綺麗に整備され、ベースコンクリートが打設された。前の地主が植えていた、桜、梅などの木があり、切らずにそのまま生かすことにした。いよいよ、自分の家が出来ると思うと、相当テンションあがる。 #image(basecon.jpg) #image(kisokouji.jpg) ***10.毎週末、事務所で、着々と工事設計を進める。クロスの色、床種類、キッチン、バス、トイレ、室内配線工事、カウンターなど各所造作関係など。決めなくてはならないことが、山ほどあるが、コーディネータが一緒に考えてくれる。照明器具、屋外オイルタンクは自分で好きな物をネットで購入して、現場配達にしておけば、取り付けは全て現場でやってもらえる。キッチン、バス、トイレは、ＩＮＡＸのショールームへ行って、いろいろ見て決める。実際に見てみると、カタログとだいぶ色に差があることがわかる。内装決めは、相当悩む。ほぼ１ヶ月かかってしまった。仕事がらＰＣを使うため、ミヤマハウスからもらった図面データを使い、いろいろ改良を重ねた。 ***11.初めての現場確認。１ヶ月くらいで、あっというまに建物の外観が姿を見せる。照明位置、キッチンカウンター高さなど、現場合わせが必要なものを工事担当者と相談しながら決める。まだ２階への階段が出来ていないため、はしごで２階へあがることになる。（この場合、高所恐怖症の人はどうするだ？とおもった。）基礎の二次元的な平面だと小さく感じた建物面積が、３次元になってみると、とても広く感じた。職人さんが、丸窓の枠を現場で一生懸命に形を整えていた。 #image(marumado.jpg) ***12.ほぼ建物が完成し、家屋調査士が立入調査に入る。これは司法書士のほうで手配してもらえるため、自分ではハンコのみ用意する。手数料７万かかる！どこを調査したのかは不明。 ***13.２回目の現場確認。まだ、内部クロス貼られていないが、ほぼ完成していた。図面でみるよりも、予想以上に素晴らしく、テンションがあがる。特に吹き抜けから燦々と光りが入り、明るいリビングが印象的だった。その後も、何度か現場に出向き、完成具合を見に行った。工事途中、ＮＴＴの光回線工事で立ち会いの必要があったが、現場担当者に代役をお願いしたところ、快く引き受けてもらえた。 #image(naibu1.jpg) #image(naibu2.jpg) #image(beranda.jpg) ***14.銀行融資の前に、住所変更手続きをする。現住所の役所に転出届けを出し、転出証明をもらい、印鑑登録手帳を返却。新住所の役所に行き、転入届、印鑑登録をし、地域の決まり事など説明を受ける。ほぼ半日かかった。 ***15.銀行から連絡があり、融資の準備が出来たとのことで、融資前の書類手続きを行う。仕事の帰りに銀行に寄り、書類の記入などで、およそ１時間半かかった。銀行のひとも、よく対応してもらえた。 ***16.銀行融資実行。銀行、司法書士、自分の３人のみ。前日に書類への記入が終わっていたため、１時間ほどで完了。自分の口座に千数百万円が入る。１時間後くらいに、ミヤマハウスに払出しが完了し、あっという間に、元の残高に戻った。 ***17.数日後、現地にて引き渡し。引き渡しの日と、次の日にミヤマハウスで完成見学会を開いた。たくさんの人に家を見てもらい、リビング、照明など、非常に好評だったと知らせがあった。自分でこだわった部分が好評だった聞き、嬉しかった。工事中玄関キーは、工事用キーであったが、引き渡し後は本キーをもらう。この本キーを一度差し込むと、工事用キーは使用不可となる。各設備の説明を現場工事担当者より受けた。田舎もの丸出しで、換気扇ひとつに　お～～という。 #image(key.jpg) **～2010年06月～ 18.最後に玄関の壁に自分で用意した表札を取り付けてもらい、ミヤマハウスのすべての工事が完了する。外水道や、社長自ら玄関アプローチの工事など、こちらの要望をサービスでやってもらえた部分がかなりあった。 ***家を建ててみて、いろんな人と話しをしたり、知らないことを知ったりと、家が完成する喜びと同時に、自分の家のために利益のためとはいえ、いろんな人が働いてくれたことが、感動と喜びであった。 *【新居完成写真】 #image(kansei1.jpg) #image(kansei3.jpg) *【庭から見える、北信五岳の眺望】 #image(gokaku.jpg) 　今後は庭のほうやらなきゃなと・・ ---- *【施工ミヤマハウスの覚え書き】軽井沢など長野県を中心に、15年でおよそ500棟のミヤマハウス住宅を建設（平成21年現在）。会社所在地：長野市穂保アップライン沿い #googlemaps(){
大きな地図で見る } >事務所へお尋ねの際、しんや@wikiを見たとお伝えください。 ---- >うちの新築工事中の様子（ミヤマハウスへジャンプ） http://www.miyama-house.co.jp/freepage_42_1.html >うちの完成（ミヤマハウスへジャンプ） http://www.miyama-house.co.jp/freepage_50_1.html >コーディネータの方のブログ http://miyama-house-haru.seesaa.net/ ---- ---- ---- ----

WindowsXPのテーマ曲 by MicroSoft

2009-10-27T21:40:43+09:00

&update(j); ---- *「WindowsXPのテーマ曲 by MicroSoft」 ---- WindowsXP使ってる人はみんな持っているこのテーマ曲以下の場所に格納されています。 C:\WINDOWS\system32\oobe\images\title.wma

True ImageをUSBメモリから起動する

2009-10-01T06:55:54+09:00

&update(j); ---- *True ImageをUSBメモリから起動する ---- １．syslinuxの取得 The Syslinux Projectからsyslinuxを取得して展開します。２．syslinuxコマンドの実行（USBドライブがj:の場合) cd syslinux\win32 syslinux.exe -maf j: ３．TrueImageのブータブルメディアビルダでUSBメモリにインストールする。

Pandoraの動画保存方法

2009-08-30T10:00:03+09:00

&update(j); ---- *Pandoraの動画保存方法 ---- Pandoraの動画保存方法はいろんなやり方がサイトで紹介されていますが、確実に保存できる方法を見つけたので紹介します。１．以下のorbitダウンローダーをインストールします。　　http://www.orbitdownloader.com/jp/ 　　インストール時に、以下の設定をします。 #image(obit1.bmp) #image(obit2.bmp) ２．InternetExprolerでPandoraにアクセスします。 IEにしか対応していないようで、FireFoxではできませんでした。３．見たいページを再生させます。４．再生がはじまったら、画面上部のGrabProの３つのアイコンのうち左側のリンクが１になっていることを確認してクリックします。 #image(obit3.bmp) ５．ダウンロード画面が開いたら右下のDownload itをクリックします。 #image(obit4.bmp) ダウンロードされたファイルは、C:\Dowunloadに入ります。 Pandoraは韓国以外からのアクセスを制限してるようで、最近つながりずらいです。どうしても欲しい動画があるときは、250円払って一週間のプレミアム会員になるのがいいかもしれません。すぐにつながります。

横向き　フレアリングのベタ

2009-08-29T13:37:25+09:00

&update(j); ---- *横向き　フレアリング中のベタ ---- 今日はベタの水槽の水換えをしました。そのときにベタのおかしな行動をみつけました。 &youtube(http://www.youtube.com/watch?v=LCEDqkMrSgI){425,350} 横になった状態でフレアリングしています。たまたま、ステンレスのキッチン台の上にプラケースを置いておいたら、下に写った自分の姿にフレアリングしたようです。水槽はこんな感じにレイアウトしておきました。 #image(200908291316000.jpg,width=640,height=480) ジクラウォータを投入して、１日おけば水槽の完成です。