[[20141021162456]] 『飛び飛びのセルにテキストボックスの値を一気に書』(まお) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『飛び飛びのセルにテキストボックスの値を一気に書き込みたい』(まお)

 いつも世話になっております

 ユーザーフォームにテキストボックスが44個、オプションボタン他があります
 コマンドボタン押下で飛び飛びのセルにテキストボックスの数値をそれぞれ書き込みたいです
 ちなみにオプションボタンにて2パターン分岐ありです

 ひとつずつ書き込むと、数式でリンクしているファイルを多数開いている場合、少し時間が(1分弱)かかります
 変数(Variant)にA1より範囲を指定し一気に書き込もうとしましたが、他のセルには数式が入っており、それらは値が貼りつきます(それはそうですよね…)

 どうすれば飛び飛びのセルにテキストボックス1から44の数値を一気に書き込むことができるのでしょうか?
 それとも根本的に書き方が悪いのでしょうか?
 実際のコードは.Cells(i, 1).Value = Me.Controls("TextBox" & j).Valueとしており、jを増やして対応しています。
 Select Caseのところかiとjのカウントの仕方が悪いのでしょうね……

 以下に書き込むセルを羅列しますが、わかりにくいのでそのまた下に実際に"ま"と書き込むコードをつけます
 パターン判別はオプションボタンのかわりにA1セルを使いました

 【パターンAの書き込みセル】
 A40,A41,A43,A44、A74,A75,A77,A78、A108,A109,A111,A112、A142,A143,A145,A146
 A176,A177,A179,A180、A189,A190,A192,A193、A223,A224,A226,A227
 A236,A237,A239,A240、A270,A271,A273,A274、A304,A305,A307,A308

 ______________________________________

 Option Explicit

 Sub TESTES()
     Dim i As Long
     Dim SRow As Long    '開始行

     With ActiveSheet

         'パターンAとBの判断(オプションボタンのかわりにA1セル)
         If Cells(1, 1).Value = True Then 'パターンBの場合の開始行
             SRow = 12
         Else                             'パターンAの場合の開始行
             SRow = 6
         End If

         For i = SRow To 304 Step 30      '開始行から30行とばし
             Select Case i
                 Case "210", "216", "257", "263"     '30行とばさない(パターンAが210と257、Bが216と263)
                     i = i - 21
             End Select

             .Cells(i, 1).Value = "ま"

             i = i + 1
             .Cells(i, 1).Value = "ま"

             i = i + 2
             .Cells(i, 1).Value = "ま"

             i = i + 1
             .Cells(i, 1).Value = "ま"

         Next i

     End With

 End Sub

< 使用 Excel:Excel2010、使用 OS:Windows7 >


1つずつ代入しかないかと…。
処理前に Application.ScreenUpdating = False して、終了時に True に戻してみては?
(???) 2014/10/21(火) 17:12

マクロでなく通常の編集作業でやると、
A40,A41,A43,A44、A74,A75,A77,A78、A108,A109,A111,A112、A142,A143,A145,A146,A176,A177,A179,A180、A189,A190,A192,A193、A223,A224,A226,A227,A236,A237,A239,A240、A270,A271,A273,A274、A304,A305,A307,A308
このセル番地をコピーして、名前ボックスにに貼り付けると、これらのセルが選択されますので、「ま」と入力して、Ctrl+Enterで確定
これで目的のセルに「ま」が書き込まれます。
(wisemac21) 2014/10/21(火) 17:16

 あと手動計算にしてみるとか!
 むしろ44個のテキストボックスの方が正気の沙汰じゃないと思いますが・・・

 それを言っても仕方ないので、私なら
 まず適当なセルに範囲で出力させます。
 今入力しようとしているセルに、出力させたセルのリンクを入れて保護しておきます。

 今入力しようとしているセルが、ユーザーフォーム以外からの入力を受け付けるのであれば
 再度考える必要は有ると思いますが・・・

 あとは入力しようとしている範囲を一度Fomulaで取り込んで、入力したいところは=を付けずに値
 だけ入れて一気に出力します。
 表作成を実行してから、サンプルを実行してみてください。
    Sub サンプル表作成()
        Range("A1:A5").Formula = "=1+ROW()"
    End Sub

    Sub サンプル()
        Dim a, r As Range
        Set r = Range("A1:A5")
        a = r.Formula
        a(2, 1) = "書き換える"
        r.Formula = a
    End Sub

 ちなみに、結合しているセルがあるとめんどくさいので、ないということ前提で。
(稲葉) 2014/10/21(火) 17:29

 ???さん
 そういえば入れてなかった!と嬉々として Application.Calculation = xlManualの前に入れてみましたが、効果なしでした……
 ありがとうございます

 wisemac21さん
 すみません、どう説明しえいいかわからなかったので、文章がゴチャゴチャしていて…
 テキストボックスからの転記なんです…
 ありがとうございます

(まお) 2014/10/21(火) 17:42


 テキストボックスのControlSourceプロパティ等試してみては ?

(ichinose) 2014/10/21(火) 17:49


 稲葉さん
 手動にはしてあったんです、言葉足らずですみません
 手動にしてあるのに、リンクしてあるファイルを同時に開くと遅くなるのです
 他のファイルをすべて閉じてあると一瞬で終わるので原因はそこですね

 テキストボックス44個、つらかったです(-"-)
 でも入力先データ改定なし、4数値ずつ紙出力のものを他人にもわかりやすくと思うとそれしか思いつきませんでした

 幸いなことに、結合セルはございません
 最後の方法、全部のセル番地書くのがいやで頭の片隅においていたのですが、 今のi使って書けるのかなー
 チャレンジしてみます
 ありがとうございます

 'Dim myC As Range にして、Set myC =Union(myC,Cells(i, 1))でつなごうと思ってただ今失敗しました
 'Forのあと、毎回リセットされちまうぜ……ふぅ

(まお) 2014/10/21(火) 17:50


 ichinoseさま
 時間がありません(派遣はつらいよ、です)ので、明日調べて必ずチャレンジいたします
 ありがとうございます
 とり急ぎ、お礼まで……
(まお) 2014/10/21(火) 17:54

 カメラ機能を使ったブックが開かれていると遅いかもしれないです。
 私も経験がありますので。

 すべてA列なら、一度A1から必要範囲まで取り込んでしまえば、あとは
 行番号ですみます。
 Array(40,41,43,44,74,75,77,78,108,109,111,112,142,143,145,146,176,177,179,180,189,190,192,193,223,224,226,227,236,237,239,240,270,271,273,274,304,305,307,308)
 配列に行番号だけ取り込んで、
 連想配列のKeyにコントロールの番号、Itemに↑の行番号をForであてはめて
 最後に、最初に取り込んでおいた配列に入れてあげればいいのでは??

(稲葉) 2014/10/21(火) 20:56


 ControlSourceプロパティは、設定時は、セルの値がテキストボックスに反映されてしまいますから、
 チョット駄目ですねえ・・・。

 失礼しました。

(ichinose) 2014/10/22(水) 06:58


 疑似からの非脱却(イベント拾わないのでいいよね・・?)

 テストしてみて、なんとか出来たのでサンプル上げます。
 適当なユーザーフォームを作って、コードをぶち込んで実行してみてください。
 パターンは転記行番号を変更してあげればいいと思います。
    Option Explicit
    Private TBCol As Collection
    Private WithEvents btn As MSForms.CommandButton

    Private Sub UserForm_Initialize()
        Set TBCol = New Collection
        Dim i As Long, T As Long, L As Long
        T = 15
        L = 10

        For i = 1 To 44
            TBCol.Add Me.Controls.Add("Forms.TextBox.1", "TB" & i, True), CStr(i)
            With TBCol(i)
                .Top = T * (i - 1) + 10
                .Left = L
            End With
        Next i

        Set btn = Me.Controls.Add("Forms.CommandButton.1", "btn", True)
        With btn
            .Top = T * (i - 1) + 10
            .Left = L
        End With

        With Me
            .Height = T * i + 40
        End With
    End Sub

    Private Sub btn_Click()
        Dim 元データ
        Dim 転記行番号, n
        Dim TB番号
        元データ = Application.Transpose(Range("A1:A310").Formula)

        転記行番号 = Array(40, 41, 43, 44, 74, 75, 77, 78, 108, 109, 111, 112, 142, 143, 145, 146, 176, 177, 179, 180, 189, 190, 192, 193, 223, 224, 226, 227, 236, 237, 239, 240, 270, 271, 273, 274, 304, 305, 307, 308)
        TB番号 = 1
        For Each n In 転記行番号
            If TB番号 > TBCol.Count Then Exit For
            元データ(n) = TBCol(TB番号)
            TB番号 = TB番号 + 1
        Next n

        Range("A1:A310").Formula = Application.Transpose(元データ)

        Unload Me
    End Sub
(稲葉) 2014/10/22(水) 09:46

 稲葉さん
 >カメラ機能を使ったブックが開かれていると遅いかもしれないです。
 それだー!!!!
 入力先のデータから数値を拾っているファイルがこれまた無茶振りされカメラ機能で対応しておりました!
 ああ……なるほど…やっぱりああいった機能って一長一短ですね…

 Arrayに羅列していただいたおかげで、自分のアホさ加減に気付きました。
 最初の6,7,9,10が抜けているorz

 で、次レスのコードですが、めっちゃ素早くユーザーフォームできあがって、転記されます
 が、実際のデータでやると、元データ = Application.Transpose(Range("A1:A310").Formula)で
型が一致しませんとなります
 ・配列に 255 文字を超える要素を含めることはできません。
 ・配列内の要素数が 5461 を超えることはできません。
 まだ調べきれていませんがこの辺があやしいのかもと原因究明中です
 取り急お礼まで…

 ichinoseさん
 >ControlSourceプロパティは、設定時は、セルの値がテキストボックスに反映されてしまいますから、
 ichinoseさんが駄目というならダメなんだろうけど、とヘルプみたり検索かけたり…
 >セルの値がテキストボックスに反映
 ということで使える場所にピンときたので、この件とは別のファイルに使用させていただきました
 ありがとうございます!

(まお) 2014/10/22(水) 13:18


 適当なセルに=REPT("a",256)
 と入力して、コピーし、A列に値として貼り付けで同じエラーが出ました。

 B1=LAN(A1)
 と入力して、256以上の文字列が入力されていないか調べてみてください。

 それを回避する方法は今のところを思いつきませんねぇ。
 精々B列に分割して、取り込み範囲を増やして最後に戻してあげる位・・・。
(稲葉) 2014/10/22(水) 14:27

 稲葉さん
 =を?に置換してから数えてみましたが、最大248文字でした
 急ぎの仕事が入りましたので、原因解明しばらく中止です

 休暇もありますので、続きは来週の火曜以降となります……
 申し訳ございません 
(まお) 2014/10/22(水) 17:04

 気にならないくらいに待ち時間短縮されたので以下でいきたいと思います
 ……省略した仕様(月シートと日付列)までのってますが(笑)

 >入力しようとしている範囲を一度Fomulaで取り込んで
 >For Each n In 転記行番号
 >    If TB番号 > TBCol.Count Then Exit For
 これは絶対自分では思いつきませんでした
 本当にありがとうございました!!

 Private Sub CommandButton1_Click()

     Dim 入力シート As Worksheet '入力先シート
     Dim 日付 As Long  '日付列
     Dim 月 As Variant   'シート名●月
     Dim パターン As String   'パターンAかパターンB
     Dim i As Long   'テキストボックスNo
     Dim 入力行, 元データ, 転記実行, n	'n=配列の行数

     Application.ScreenUpdating = False
     Application.Calculation = xlManual

     月 = ThisWorkbook.Worksheets("Sheet1").Range("B2").Value
      '●月シート指定。これをユーザーフォームに入れると混乱の元になった。理解不能
     Set 入力シート = Workbooks("book1.xlsx").Worksheets(月)
     日付 = ComboBox1.Value + 6    '日付列 前6列見出しの為

     If OptionButton1.Value = True Then  'パターンAの行
         パターン = OptionButton1.Caption
         入力行 = Array(6, 7, 9, 10, 40, 41, 43, 44, 74, 75, 77, 78, 108, 109, 111, 112, 142, 143, 145, 146, 176, 177, 179, 180, 189, 190, 192, 193, 223, 224, 226, 227, 236, 237, 239, 240, 270, 271, 273, 274, 304, 305, 307, 308)

     Else  'パターンBの行
         パターン = OptionButton2.Caption
         入力行 = Array(12, 13, 15, 16, 46, 47, 49, 50, 80, 81, 83, 84, 114, 115, 117, 118, 148, 149, 151, 152, 182, 183, 185, 186, 195, 196, 198, 199, 229, 230, 232, 233, 242, 243, 245, 246, 276, 277, 279, 280, 310, 311, 313, 314)

     End If

     転記実行 = MsgBox("book1の" & 月 & ComboBox1.Value & "日の" & パターン & "に転記しますか?", vbYesNo, "転記実行")    '確認

     Select Case 転記実行
         Case vbYes

             元データ = 入力シート.Range(入力シート.Cells(1, 日付), 入力シート.Cells(314, 日付 + 1)).Formula
             i = 1
             For Each n In 入力行
                 If i > 45 Then Exit For
                     元データ(n, 1) = Me.Controls("TextBox" & i).Value
                     i = i + 1
             Next n

             入力シート.Range(入力シート.Cells(1, 日付), 入力シート.Cells(314, 日付 + 1)).Formula = 元データ

             MsgBox "転記完了しました"   '完了報告

         Case vbNo

             MsgBox "転記をキャンセルしました"   'キャンセル報告

     End Select

     Application.Calculation = xlCalculationAutomatic
     Application.ScreenUpdating = True

 End Sub

 あと、他にまおさんいらっしゃったみたいで失礼いたしました!!
(まお 改め もあ) 2014/10/29(水) 18:08

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.