▲VBA - jorky @ ウィキ

******************************************
EXCEL の　xlsファイル　フォーマット　解除
******************************************
●セルの結合を解除して同じ値を入力

Sub セルの結合を解除して同じ値を入力()
Dim mydate As String
i = 4
Do While i < 30
    Cells(4, i).Activate
    
    Do Until ActiveCell = ""
        mydate = ActiveCell.Value
              If ActiveCell.MergeCells Then
                    ActiveCell.UnMerge
                    Selection.Value = mydate
              Else
                       ActiveCell.Offset(1).Activate
               End If
    Loop
    i = i + 1
Loop
End Sub

*********************************************************
EXCEL のデータから　txtファイルへ出力する。
*********************************************************
Option Explicit

' テキストファイル書き出すサンプル
Sub WRITE_TextFile()
    Const cnsTITLE = "テキストファイル出力処理"
    Const cnsFILTER = "テキストファイル (*.txt;*.dat),*.txt;*.dat"
    Dim xlAPP As Application        ' Applicationオブジェクト
    Dim intFF As Integer            ' FreeFile値
    Dim strFILENAME As String       ' OPENするファイル名(フルパス)
    Dim strREC As String            ' 書き出すレコード内容
    Dim Retu As Long
    Dim GYO As Long                 ' 収容するセルの行
    Dim MaxRow As Long              ' データが収容された最終行
    Dim MaxCol As Long
    Dim lngREC As Long              ' レコード件数カウンタ

    ' Applicationオブジェクト取得
    Set xlAPP = Application
    ' 「名前を付けて保存」のフォームでファイル名の指定を受ける
    xlAPP.StatusBar = "出力するファイル名を指定して下さい。"            ' ①
    strFILENAME = xlAPP.GetSaveAsFilename(InitialFileName:=ActiveSheet.Name & ".sql", _
        FileFilter:=cnsFILTER, Title:=cnsTITLE)
    ' キャンセルされた場合は以降の処理は行なわない
    If StrConv(strFILENAME, vbUpperCase) = "FALSE" Then Exit Sub

'入力範囲の行列を取得する。
    With ActiveSheet.UsedRange
        MaxRow = .Rows.Count
        MaxCol = .Columns.Count
    End With
  ' 収容最終行の判定(Excel認知の最終行から上に向かってデータがある行を探す)
　' MaxRow = Cells.SpecialCells(xlCellTypeLastCell).Row                 ' ②
    Do While Cells(MaxRow, 1).Value = ""                                ' ③
        MaxRow = MaxRow - 1
    Loop
    If MaxRow < 2 Then
        xlAPP.StatusBar = False
        MsgBox "テキストをA列2行目から入力してから起動して下さい。", , cnsTITLE
        Exit Sub
    End If

    ' FreeFile値の取得(以降この値で入出力する)
    intFF = FreeFile
    ' 指定ファイルをOPEN(出力モード)
    Open strFILENAME For Output As #intFF                               ' ④
    ' 2行目から開始
    GYO = 2
    ' 最終行まで繰り返す
    Do Until GYO > MaxRow
        ' A列内容をレコードにセット(先頭は2行目)
        Retu = 1
        strREC = ""
        Do Until Retu > MaxCol
        strREC = strREC & Cells(GYO, Retu).Value
        
        Retu = Retu + 1
        Loop
        
        ' レコードを出力
        Print #intFF, strREC ' ⑥
         ' レコード件数カウンタの加算
        
        
        lngREC = lngREC + 1
        xlAPP.StatusBar = "出力中です．．．．(" & lngREC & "レコード目)"

        ' 行を加算
        GYO = GYO + 1
        
    Loop
    ' 指定ファイルをCLOSE
    Close #intFF
    xlAPP.StatusBar = False
    ' 終了の表示
    MsgBox "ファイル出力が完了しました。" & vbCr & _
        "レコード件数=" & lngREC & "件", vbInformation, cnsTITLE
End Sub

***********************************************************************************