1

こんにちは、シート1から他のシートに行全体を選択的にコピーする必要があります。現在、チェックボックスを使用して行を選択し、選択した行をユーザーが選択したシートにコピーしています。しかし、私は奇妙なエラーに直面しています。しばらくの間、コードが正常に実行され、正確なデータがシートにコピーされますが、しばらくすると、どこからともなく誤った値がコピーされます。これで私を助けてもらえますか？私が使用しているコードを貼り付けます。

Sub Addcheckboxes()
Dim cell, LRow As Single
Dim chkbx As CheckBox
Dim MyLeft, MyTop, MyHeight, MyWidth As Double

Application.ScreenUpdating = False
LRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

For cell = 2 To LRow
    If Cells(cell, "A").Value <> "" Then
        MyLeft = Cells(cell, "E").Left
        MyTop = Cells(cell, "E").Top
        MyHeight = Cells(cell, "E").Height
        MyWidth = Cells(cell, "E").Width
        ActiveSheet.CheckBoxes.Add(MyLeft, MyTop, MyWidth, MyHeight).Select
        With Selection
            .Caption = ""
            .Value = xlOff
            .Display3DShading = False
        End With
    End If
Next cell

Application.ScreenUpdating = True
End Sub


Sub RemoveCheckboxes()
Dim chkbx As CheckBox
For Each chkbx In ActiveSheet.CheckBoxes
    chkbx.Delete
Next
End Sub


Sub CopyRows()
Dim Val As String
Val = InputBox(Prompt:="Sheet name please.", _
          Title:="ENTER SHEET NAME", Default:="Sheet Name here")
For Each chkbx In ActiveSheet.CheckBoxes
    If chkbx.Value = 1 Then
        For r = 1 To Rows.Count
            If Cells(r, 1).Top = chkbx.Top Then
                With Worksheets(Val)
                    LRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
                    .Range("A" & LRow & ":AF" & LRow) = _
                    Worksheets("Usable_Inv_Data").Range("A" & r & ":AF" & r).Value
                End With
                Exit For
            End If
        Next r
    End If
Next
End Sub

通常のコピー出力: ここに画像の説明を入力

同じ値の誤ったコピー出力: ここに画像の説明を入力

4

3 に答える 3

1

LinkedCell プロパティでチェックボックスを追加しました。これは、チェックボックスがオンになっているときに行を識別するのに役立ちます。また、ワークブックが存在するかどうかを確認する関数 check_worksheet_exists を追加しました。

Sub Addcheckboxes()
Dim cell, LRow As Single
Dim chkbx As CheckBox
Dim MyLeft, MyTop, MyHeight, MyWidth As Double

Application.ScreenUpdating = False
LRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).row

For cell = 2 To LRow
    If Cells(cell, "A").Value <> "" Then
        MyLeft = Cells(cell, "E").Left
        MyTop = Cells(cell, "E").Top
        MyHeight = Cells(cell, "E").Height
        MyWidth = Cells(cell, "E").Width
        ActiveSheet.CheckBoxes.Add(MyLeft, MyTop, MyWidth, MyHeight).Select
        With Selection
            .Caption = ""
            .Value = xlOff
            .Display3DShading = False
            .LinkedCell = Cells(cell, "AZ").Address
        End With
    End If
Next cell

Application.ScreenUpdating = True
End Sub


Sub RemoveCheckboxes()
Dim chkbx As CheckBox
For Each chkbx In ActiveSheet.CheckBoxes
    chkbx.Delete
Next
End Sub


Sub CopyRows()

    Dim Val As String
    Dim row As Long

    Val = InputBox(Prompt:="Sheet name please.", Title:="ENTER SHEET NAME", Default:="Sheet Name here")

    If check_worksheet_exists(ThisWorkbook, Val, False) = False Then
        Exit Sub
    End If

    For Each chkbx In ActiveSheet.CheckBoxes
        If chkbx.Value = 1 Then
            row = Range(chkbx.LinkedCell).row

            With Worksheets(Val)
                LRow = .Range("A" & Rows.Count).End(xlUp).row + 1
                .Range("A" & LRow & ":AF" & LRow) = ActiveSheet.Range("A" & row & ":AF" & row).Value
            End With

        End If
    Next
End Sub




Function check_worksheet_exists(tBook As Workbook, ByVal check_sheet As String, Optional no_warning As Boolean = False) As Boolean

    On Error Resume Next
    Dim wkSht As Worksheet
    Set wkSht = tBook.Sheets(check_sheet)

    If Not wkSht Is Nothing Then
        check_worksheet_exists = True
    ElseIf wkSht Is Nothing And no_warning = False Then
        MsgBox "'" & check_sheet & "' sheet does not exist", vbCritical, "Error"
    End If

    On Error GoTo 0

End Function
于 2013-07-16T16:49:34.423 に答える
1

通常の出力と誤った出力を簡単に比較すると、宛先シート (値を「貼り付ける」場所) でセル/列の一部が正しくフォーマットされていないように見えます。

たとえば、通常のコピー (値 582.16) の Base Change 列は、General または Number としてフォーマットされます。宛先シートの同じ列が日付としてフォーマットされます (582.16 を Excel で日付値に変換すると、画面に示すように、1901 年 8 月 4 日または 01 年 8 月 4 日になります。

期待するデータ型を表示するように列がフォーマットされていることを確認してください。目的のシートで列を選択し、[セルの書式設定] を右クリックして、適切なデータ型を選択します。

- -編集 - -

書式設定を自動化するには、書式を含めて値をコピーして貼り付ける必要があります。コードは次のように変更されます。

With Worksheets(Val)
    LRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
    .Range("A" & LRow & ":AF" & LRow) = _
    Worksheets("Usable_Inv_Data").Range("A" & r & ":AF" & r).Value
End With

に

With Worksheets(Val)
    LRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
    Worksheets("Usable_Inv_Data").Range("A" & r & ":AF" & r).Copy
    .Range("A" & LRow).PasteSpecial (xlPasteValuesAndNumberFormats)
End With
于 2013-07-16T16:35:29.617 に答える
0

ハッシュ記号のシーケンスを参照していない限り、参照しているエラーをすぐに確認できません ###? これらは、列の幅が十分でないことを示しているだけです。

Worksheets(Val).Range("A1").CurrentRegion.EntireColumn.AutoFit

ところで、Val は賢明な変数名だとは思いません ;)

于 2013-07-16T16:34:54.980 に答える