• [ExcelVBA]BOOKクローズ時に保存しないように
OwnBook.Saved = True
 

  • [ExcelVBA]Excelブックをオブジェクト変数にセット
'//EXCELVBAブックをオブジェクト変数にセット
    Set OwnBook = ActiveWorkbook
    Set DataSheet = OwnBook.Worksheets("data")
    Set TemplateSheet = OwnBook.Worksheets("template")
 

  • [ExcelVBA]データシートの行数取得
DataSheetRowCnt = DataSheet.Range("A1").CurrentRegion.Rows.Count
 

  • [ExcelVBA]テキスト取込み
Dim j As Integer
 
   Worksheets("Sheet1").Select
 
 
    Open "D:\MyDocuments\data.txt" For Input As #1
 
 
    '//変数初期化
    i = 0
 
   Do Until EOF(1)
        Input #1, _
        myBuf(1), myBuf(2), myBuf(3), myBuf(4), myBuf(5), myBuf(6), myBuf(7), myBuf(8), myBuf(9), myBuf(10), myBuf(11), myBuf(12), myBuf(13), myBuf(14), myBuf(15), myBuf(16), myBuf(17), myBuf(18), myBuf(19), myBuf(20), _
        myBuf(21), myBuf(22), myBuf(23), myBuf(24), myBuf(25), myBuf(26), myBuf(27), myBuf(28), myBuf(29), myBuf(30), myBuf(31), myBuf(32), myBuf(33), myBuf(34), myBuf(35), myBuf(36), myBuf(37), myBuf(38), myBuf(39), myBuf(40), _
        myBuf(41), myBuf(42), myBuf(43), myBuf(44), myBuf(45), myBuf(46), myBuf(47), myBuf(48), myBuf(49), myBuf(50), myBuf(51), myBuf(52), myBuf(53), myBuf(54), myBuf(55), myBuf(56), myBuf(57), myBuf(58), myBuf(59), myBuf(60), _
        myBuf(61), myBuf(62), myBuf(63), myBuf(64), myBuf(65), myBuf(66), myBuf(67), myBuf(68), myBuf(69), myBuf(70), myBuf(71), myBuf(72), myBuf(73), myBuf(74), myBuf(75), myBuf(76), myBuf(77), myBuf(78), myBuf(79), myBuf(80), _
        myBuf(81), myBuf(82), myBuf(83), myBuf(84), myBuf(85), myBuf(86), myBuf(87), myBuf(88), myBuf(89), myBuf(90), myBuf(91), myBuf(92), myBuf(93), myBuf(94), myBuf(95), myBuf(96), myBuf(97), myBuf(98), myBuf(99), myBuf(100), _
        myBuf(101), myBuf(102), myBuf(103), myBuf(104), myBuf(105), myBuf(106), myBuf(107), myBuf(108), myBuf(109), myBuf(110), myBuf(111), myBuf(112), myBuf(113), myBuf(114), myBuf(115), myBuf(116), myBuf(117), myBuf(118), myBuf(119), myBuf(120), _
        myBuf(121), myBuf(122), myBuf(123), myBuf(124), myBuf(125), myBuf(126), myBuf(127), myBuf(128), myBuf(129), myBuf(130), myBuf(131), myBuf(132), myBuf(133), myBuf(134), myBuf(135), myBuf(136), myBuf(137), myBuf(138), myBuf(139), myBuf(140), _
        myBuf(141), myBuf(142), myBuf(143), myBuf(144), myBuf(145), myBuf(146), myBuf(147), myBuf(148), myBuf(149), myBuf(150), myBuf(151), myBuf(152), myBuf(153), myBuf(154), myBuf(155), myBuf(156), myBuf(157), myBuf(158), myBuf(159), myBuf(160), _
        myBuf(161), myBuf(162), myBuf(163), myBuf(164), myBuf(165), myBuf(166), myBuf(167), myBuf(168), myBuf(169), myBuf(170), myBuf(171), myBuf(172), myBuf(173), myBuf(174), myBuf(175), myBuf(176), myBuf(177), myBuf(178), myBuf(179), myBuf(180), _
        myBuf(181), myBuf(182), myBuf(183), myBuf(184), myBuf(185), myBuf(186), myBuf(187), myBuf(188), myBuf(189), myBuf(190), myBuf(191), myBuf(192), myBuf(193), myBuf(194), myBuf(195), myBuf(196), myBuf(197), myBuf(198), myBuf(199), myBuf(200), _
        myBuf(201), myBuf(202), myBuf(203), myBuf(204), myBuf(205), myBuf(206), myBuf(207), myBuf(208), myBuf(209), myBuf(210), myBuf(211), myBuf(212), myBuf(213), myBuf(214), myBuf(215), myBuf(216), myBuf(217), myBuf(218), myBuf(219), myBuf(220), _
        myBuf(221), myBuf(222), myBuf(223), myBuf(224), myBuf(225), myBuf(226), myBuf(227), myBuf(228), myBuf(229), myBuf(230), myBuf(231), myBuf(232), myBuf(233), myBuf(234), myBuf(235), myBuf(236), myBuf(237), myBuf(238), myBuf(239), myBuf(240), _
        myBuf(241), myBuf(242), myBuf(243), myBuf(244), myBuf(245), myBuf(246), myBuf(247), myBuf(248), myBuf(249)
 
        i = i + 1
 
        For j = 1 To 249
            Cells(i, j) = myBuf(j)
        Next j
 
    Loop
    Close #1
 

  • [ExcelVBA]テキスト出力
Sub outputXML()
 
Dim SaveFilename As String
Dim i As Integer
Dim DataSheetRowCnt As Integer
 
 
'データ行数取得
DataSheetRowCnt = ActiveWorkbook.Worksheets("Sheet1").Range("A1").CurrentRegion.Rows.Count
 
 
'SaveFilename = Application.GetSaveAsFilename("test", "(*.xml),*.xml", , "結果の保存")
 SaveFilename = ActiveWorkbook.Path & "\" & "address.xml"
 
    MsgBox SaveFilename & vbCr & "に出力されました"
 
 
    Open SaveFilename For Output As #1
 
    Print #1, "<?xml version='1.0' encoding='Shift_JIS'?>"
    Print #1, "<?xml-stylesheet type='text/xsl' href='address.xsl'?>"
 
    Print #1, "<名簿>"
 
    For i = 3 To DataSheetRowCnt
 
        Print #1, "<連絡先>"
        Print #1, "<正式名称>"; Cells(i, 1).Value; "</正式名称>"
        Print #1, "<略称>"; Cells(i, 2).Value; "</略称>"
        Print #1, "<担当者>"; Cells(i, 3).Value; "</担当者>"
        Print #1, "<内線>"; Replace(Cells(i, 4).Value, Chr(10), "、"); "</内線>"
        Print #1, "<メールアドレス>"; Replace(Cells(i, 5).Value, Chr(10), "、"); "</メールアドレス>"
        Print #1, "<担当システム>"; Replace(Cells(i, 6).Value, Chr(10), "、"); "</担当システム>"
        Print #1, "<備考>"; Cells(i, 7).Value; "</備考>"
        Print #1, "<補足>"; Cells(i, 8).Value; "</補足>"
        Print #1, "</連絡先>"
 
    Next i
 
    Print #1, "</名簿>"
    Close #1
 
ActiveWorkbook.Save
 
End Sub
 

  • [ExcelVBA]フォルダ選択ダイアログ
'■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
'パブリック変数宣言
'■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■

'■定数■
'/* BrowseForFolder Method Options */
Const BIF_RETURNONLYFSDIRS = &H1        '// Only return file system directories.

 
 
'■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
' フォルダ取得ダイアログを表示する
'
' (BrowseForFolder関数)
'  引数 sTitle      タイトルの文字列
'         nOptions    選択オプションの値
'         sRootFolder 既定フォルダの文字列
'■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■

Public Function BrowseForFolder(sTitle As String, nOptions, Optional sRootFolder As String = "") As String
Dim oShell As Object
Dim oFolder As Object
 
    Set oShell = CreateObject("Shell.Application")
    Set oFolder = oShell.BrowseForFolder(0, sTitle, nOptions, sRootFolder)
 
    If oFolder Is Nothing Then
        BrowseForFolder = ""
    Else
        If oFolder.ParentFolder Is Nothing Then '下位の未選択デスクトップ
            Dim objWShell As Object ' WScript.Shell
            
            'シェルのオブジェクトを作成
            Set objWShell = CreateObject("WScript.Shell")
 
            'デスクトップの場所を返す
            BrowseForFolder = objWShell.SpecialFolders("Desktop")
 
            'オブジェクトの解放
            Set objWShell = Nothing
        Else
            BrowseForFolder = oFolder.Items.Item.Path 'パスをセットする
        End If
    End If
 
 
 
 
 
    Set oFolder = Nothing
    Set oShell = Nothing
End Function
 
sub 呼び出しがわ()
 
dim PUB_SAVE_FOLDER as String
 
PUB_SAVE_FOLDER = BrowseForFolder(mymsg, BIF_RETURNONLYFSDIRS, "")
 
Msgbox PUB_SAVE_FOLDER
 
end sub 
 

  • [ExcelVBA]改行コードの除去
Sub test()
 
    Dim value1 As String
 
    value1 = Cells(1, 2)
 
 
    value1 = Replace(value1, Chr(10), "") '改行コードの除去 Chr(10)= LF:改行
 
    MsgBox value1
 
    Cells(2, 1) = value1
 
End Sub
 

  • [ExcelVBA]全シート選択・プレビュー
Dim i As Integer
 
    For i = ActiveWorkbook.Worksheets.Count To 1 Step -1
                ActiveWorkbook.Worksheets(i).Select fase
    Next i
 
    ActiveWindow.SelectedSheets
 

  • [Excel関数]色々

■(例)セル値が○になっているデータの数をカウントする。
=COUNTIF(E4:E25,"○")
 
■(例)セル値が空欄の数をカウントする。
=COUNTBLANK(E5:E27)
 
最終更新:2008年01月04日 04:51