-18


エクセルのVBAについて質問です。

現在データの閲覧をしやすいようにしたいと考えております。

行いたいことですが、基のデータ(シート1)を条件判定ごとにSheet2、Sheet3、Sheet4とに分けるやり方です。

行いたいプログラムを実行する環境ですが以下になっております。

http://oskuni7.sakura.ne.jp/hatena//question18/question18.htm

今回ですがSheet2のデータが変更された場合、それに応じて元データのSheet1のデータの値が変更するようにしたいと考えております。

またSheet2の条件判定を変えるとSheet3やSheet4にデータが移動するということも行いたいです。

上記のようなプログラムを時間があるかたで作成していただけるかたおりましたら作成していただけないでしょうか?

またエクセルの横列を増やしていくうちに

データの消失を防ぐため、空白でないセルをワークシートの外にシフトすることはできません。

というエラーが出てきます。

エクセルのデータ保存の機能を拡張する方法などはないでしょうか?

いずれか知っているかたおりましたら、

お手数をおかけしますがどうぞよろしくお願いいたします。

回答の条件
  • 1人5回まで
  • 登録:2009/01/26 01:31:35
  • 終了:2009/02/02 01:35:02

ベストアンサー

id:SALINGER No.1

SALINGER回答回数3454ベストアンサー獲得回数9692009/01/28 01:22:17

ポイント60pt

とりあえずシートに分けるマクロは作ってみました。

まず、各シートは4行目からデータが入っているとして、

図のようにSheet1の1行目の作業1とか作業2というのはマージされたセルとします。

ここから作業の数を数えて自動的に作業1とか作業2という名前のシートを作りデータをコピーします。

コピーする列は図ならば作業1がBL列~EO列までという感じです。


>★Sheet2,3,4のデータの判定(列AV)を変更した場合、データの移動が行われます。

この機能は実装しませんでした。この機能を実装することにより、かなりのオーバーヘッドが発生し

処理が重くなると思われます。面倒でもマクロを一回一回実行させたほうがいいと思われます。


Option Explicit

Type Sagyou
    name As String
    start As Integer
    end As Integer
    count As Long
End Type

Sub SheetWake()
    Application.ScreenUpdating = False
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    Dim s() As Sagyou
    Dim f As Boolean
    ReDim s(0)
    Dim sh As Worksheet
    Dim lastRow As Long
    Dim r As Range
    
    '作業データの取得
    j = 1
    For i = 63 To 255
        If Sheet1.Cells(1, i).MergeCells Then
            If Not f Then
                ReDim Preserve s(UBound(s) + 1)
                s(UBound(s)).name = Sheet1.Cells(1, i).Value
                s(UBound(s)).start = i
                f = True
            End If
            s(UBound(s)).end = i
        Else
            f = False
        End If
    Next i
    
    'シートの追加
    For i = 1 To UBound(s)
        f = False
        For Each sh In Worksheets
            If sh.name = s(i).name Then
                Sheet1.Range(Cells(1, s(i).start), Cells(3, s(i).end)).Copy sh.Range("A1")
                f = True
                Exit For
            End If
        Next
        If Not f Then
            Set sh = Worksheets.Add
            sh.name = s(i).name
            Sheet1.Activate
            Sheet1.Range(Cells(1, s(i).start), Cells(3, s(i).end)).Copy sh.Range("A1")
        End If
    Next i
    
    '数式の除去
    For Each r In Sheet1.UsedRange
        If r.Row > 3 Then
            r.Value = r.Value
        End If
    Next
    
    'シートのクリア
    For Each sh In Worksheets
        If sh.name <> "Sheet1" Then
            sh.Rows("4:65536").ClearContents
        End If
    Next
    
    'データの移動
    lastRow = Sheet1.UsedRange.Rows(Sheet1.UsedRange.Rows.count).Row
    For i = 4 To lastRow
        f = False
        For j = 1 To UBound(s)
            If Sheet1.Cells(i, "AV").Value = s(j).name Then
                f = True
                Exit For
            End If
        Next
        If f Then
            Set sh = Worksheets(Sheet1.Cells(i, "AV").Value)
            sh.Cells(s(j).count + 4, 1).Value = s(j).name
            Sheet1.Cells(i, "AV").Formula = "=" & s(j).name & "!A" & s(j).count + 4
            For k = 1 To s(j).end - s(j).start
                sh.Cells(s(j).count + 4, k + 1).Value = Sheet1.Cells(i, s(j).start + k).Value
                Sheet1.Cells(i, s(j).start + k).Formula = "=" & s(j).name & "!" & sh.Cells(s(j).count + 4, k + 1).Address
            Next
            s(j).count = s(j).count + 1
        End If
    Next i
    Application.ScreenUpdating = True
End Sub
id:aiomock

ご回答有難うございます。

試してみます。

2009/01/29 11:40:36
  • id:aiomock
    データの消失を防ぐため、空白でないセルをワークシートの外にシフトすることはできません。

    というエラーが発生し最近困っております。

    どういう際に起こるかというと列を挿入する際です。

    横列数が少ない場合は大丈夫なのですが、列数が増えてくるといつもこのエラーが発生してしまいます。

    横に長いものをSheetごとにいくつか分けてすべてのSheetに関連性を持たせる。

    エクセルの機能を拡張する

    など考えてみたのですが、何か良い方法を知っているかたおりましたらよろしくお願いいたします。
  • id:Mook
    EXCEL 2003 まででは行の上限が65536行、列の上限が255列ですから、最終行や最終列にデータや数式がある状態で
    行や列を挿入しようとすると表記のエラーが出ます。

    EXCEL 2007ではこれが大幅(行は100万行以上、列は16384列)に変更されていますので、機能を拡張したいという
    要望があるのでしたら、この機会にバージョンアップするのも手かもしれません。
    (2003での機能拡張では列を増やすことはできません。)

    http://msdn.microsoft.com/ja-jp/library/aa730921.aspx
  • id:aiomock
    Mook さん

    ご回答ありがとうございます。

    EXCEL2007のバージョンアップ検討してみます。


この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません