OwnBook.Saved = True
'//EXCELVBAブックをオブジェクト変数にセット
Set OwnBook = ActiveWorkbook
Set DataSheet = OwnBook.Worksheets("data")
Set TemplateSheet = OwnBook.Worksheets("template")
DataSheetRowCnt = DataSheet.Range("A1").CurrentRegion.Rows.Count
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
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
'■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
'パブリック変数宣言
'■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
'■定数■
'/* 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
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
Dim i As Integer
For i = ActiveWorkbook.Worksheets.Count To 1 Step -1
ActiveWorkbook.Worksheets(i).Select fase
Next i
ActiveWindow.SelectedSheets
■(例)セル値が○になっているデータの数をカウントする。
=COUNTIF(E4:E25,"○")
■(例)セル値が空欄の数をカウントする。
=COUNTBLANK(E5:E27)