bridetobe

中學生 Rank: 2

帖子: 28
主題: 6
精華: 0
積分: 50
點名: 0
作業系統: Windows7
軟體版本: Office2003
閱讀權限: 20
性別: 女
來自: 新北市
註冊時間: 2014-7-2
最後登錄: 2014-8-25

1^# 跳轉到 » 正序看帖

打印

字體大小: tT

發表於 2014-8-7 09:19 | 只看該作者

[發問] 欄位貼上問題

塗料存貨管理(20140806).rar (63.7 KB)

想請問一下
按下讀出可以將8/6的資料全部讀取出來
然後利用"操作"工作表更改8/7的存貨

按下寫入可以
跳出一個inputbox詢問要增加為幾月幾號的資料
再將更改完的資料(除了A1:G2)的資料

(圖中紅框框部分)
往"存貨資料"工作表B欄最下面往下貼

(圖中紅線部分)
然後將Inputbox內的日期貼到與資料同行

(將圖中A欄空白資料用inputbox內的內容填滿)
請問這些步驟這要怎麼完成?

原本有想過使用巨集錄製
將整個操作工作表的內容
複製到其他工作表然後把標題列(A1:G2)刪除
再複製到存貨資料工作表內
但怎麼寫都寫不出來
還請各位大大幫幫忙

樓主熱帖

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

14^#

發表於 2014-8-7 15:49 | 只看該作者

結果讀出變成無法使用??
bridetobe 發表於 2014/8/7 11:28

Private Sub CommandButton2_Click()
Range("A59").Select
Selection.CurrentRegion.Select
Selection.Copy
Sheets("Sheet4").Select
With Sheet4
ActiveSheet.Paste
'Range("A1:G2").Select '這裡出錯
'這CommandButton2是"操作"工作表[物件模組]的程序
'Range("A1:G2").Select是"操作"工作表的Range.Select,不是ActiveSheet的Range.Select
'如CommandButton2_Click()程式碼複製在一般模組
'這Range是ActiveSheet的Range
.Range("A1:G2").Select '前面的. 表為With Sheet4的物件,屬性..
Application.CutCopyMode = False
Selection.ClearContents
Range("A4").Select
Selection.CurrentRegion.Select
Selection.Copy
End With
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

TOP

bridetobe

中學生 Rank: 2

帖子: 28
主題: 6
精華: 0
積分: 50
點名: 0
作業系統: Windows7
軟體版本: Office2003
閱讀權限: 20
性別: 女
來自: 新北市
註冊時間: 2014-7-2
最後登錄: 2014-8-25

13^#

發表於 2014-8-7 11:31 | 只看該作者

回復 11# Hsieh

也謝謝版大~~

你們兩個的方法都可以

我一直膩在最基礎的寫法
一直想不到該怎麼用

真的非常謝謝兩位

TOP

bridetobe

中學生 Rank: 2

帖子: 28
主題: 6
精華: 0
積分: 50
點名: 0
作業系統: Windows7
軟體版本: Office2003
閱讀權限: 20
性別: 女
來自: 新北市
註冊時間: 2014-7-2
最後登錄: 2014-8-25

12^#

發表於 2014-8-7 11:28 | 只看該作者

回復 10# GBKEE

真的非常謝謝!
寫入欄位可以使用了
結果讀出變成無法使用??

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 142
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2026-7-16

2025年全勤獎章 2024年全勤獎章 2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

11^#

發表於 2014-8-7 10:58 | 只看該作者

回復 9# bridetobe

Private Sub CommandButton2_Click()
Rng = Range([A3:G3], [A3:G3].End(xlDown)).Value '資料讀入陣列
With Sheets("存貨資料")
d = InputBox("輸入日期(例2014/7/1):", , Format(Application.Max(.[A:A]) + 1, "yyyy/m/d")) '預設為最大日期加1
If d = "" Then Exit Sub '取消輸入
Set A = .Cells(.Rows.Count, 1).End(xlUp).Offset(1) '找到資料尾的下一列A欄位置
A.Offset(, 1).Resize(UBound(Rng), 7) = Rng '將資料寫入工作表
A.Resize(UBound(Rng), 1) = d 'A欄寫入日期
End With
End Sub

複製代碼

學海無涯_不恥下問

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

10^#

發表於 2014-8-7 10:43 | 只看該作者

本帖最後由 GBKEE 於 2014-8-7 10:47 編輯

回復 9# bridetobe

Private Sub CommandButton1_Click()
Dim srcrange As Range
Dim a_date As String
Dim fndrange As Range, fstaddress As String, i As Integer
a_date = InputBox("輸入日期(例2014/7/1):", , "2014/7/1")
Application.ScreenUpdating = False
'******************
Range("A3", Range("A3").End(xlDown)).Resize(, 7).ClearContents
'*****************
If a_date = "" Then Exit Sub

複製代碼

Private Sub CommandButton2_Click()
Dim Rng As Range
With Sheets("操作")
Set Rng = .Range("A3", .Range("A3").End(xlDown)).Resize(, 7)
With Sheets("存貨資料").Range("B1").End(xlDown).Offset(1)
.Resize(Rng.Rows.Count, Rng.Columns.Count) = Rng.Value
.Offset(, -1).Resize(Rng.Rows.Count) = Sheets("操作").[b1]
End With
End With
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

TOP

bridetobe

中學生 Rank: 2

帖子: 28
主題: 6
精華: 0
積分: 50
點名: 0
作業系統: Windows7
軟體版本: Office2003
閱讀權限: 20
性別: 女
來自: 新北市
註冊時間: 2014-7-2
最後登錄: 2014-8-25

9^#

發表於 2014-8-4 16:06 | 只看該作者

回復 7# GBKEE

解決了
非常謝謝版大~~~

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

8^#

發表於 2014-7-30 15:14 | 只看該作者

本帖最後由 GBKEE 於 2014-7-30 15:15 編輯

回復 6# bridetobe
Find 會根據上ㄧ次Find的參數來搜尋

Private Sub CommandButton1_Click()
Dim srcrange As Range
Dim a_date As String
Dim fndrange As Range, fstaddress As String, i As Integer
a_date = InputBox("輸入日期(例2014/7/1):", , "2014/7/1")
If a_date = "" Then Exit Sub '取消時
With Sheet2
Set srcrange = .Range("A2", .[a2].End(xlDown))
srcrange.Interior.ColorIndex = xlNone
Set fndrange = srcrange.Find(what:=a_date, AFTER:=srcrange(srcrange.Count), LookIn:=xlValues, lookat:=xlWhole) '搜尋文字
'After 選擇性的 Variant。指定儲存格，尋找將從該儲存格之後開始。此儲存格對應於從使用者介面尋找時的使用中儲存格位置。
'注意 After 必須是尋找範圍中的單個儲存格。請記住尋找是從該儲存格之後開始的；必須等到該方法循環回到此儲存格時，才會搜尋其內容。
'如果未指定此引數，搜尋將從範圍的左上角儲存格之後開始
'LookAt 選擇性的 Variant。可為下列 XlLookAt 常數之一：xlWhole 或 xlPart。
End With
If Not fndrange Is Nothing Then
'fstaddress = fndress = fndrange.Address '這裡錯誤讓他無止盡的貼下去
fstaddress = fndrange.Address
i = 3
Do
fndrange.Interior.Color = vbRed
Cells(i, 1).Resize(1, 7) = fndrange.Offset(, 1).Resize(1, 7).Value
Set fndrange = srcrange.FindNext(AFTER:=fndrange)
i = i + 1
Loop Until fndrange.Address = fstaddress
Else
MsgBox ("沒有資料")
End If
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

TOP

bridetobe

中學生 Rank: 2

帖子: 28
主題: 6
精華: 0
積分: 50
點名: 0
作業系統: Windows7
軟體版本: Office2003
閱讀權限: 20
性別: 女
來自: 新北市
註冊時間: 2014-7-2
最後登錄: 2014-8-25

7^#

發表於 2014-7-29 09:04 | 只看該作者

回復 5# GBKEE

謝謝
解決了無止盡貼下去了
可是發現不只貼上7/1號的
還有夾雜一些其他的日期的
7/7 等等的貼到了7xx多列

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

6^#

發表於 2014-7-28 17:21 | 只看該作者

回復 4# bridetobe
試試看

Private Sub CommandButton1_Click()
Dim srcrange As Range
Dim a_date ' As String
Dim fndrange, fstaddress, i
a_date = InputBox("輸入日期(例2014/7/1):", , "2014/7/1")
If a_date = "" Then Exit Sub '取消時
With Sheet2
Set srcrange = .Range("A2", .[a2].End(xlDown))
Set fndrange = srcrange.Find(what:=a_date, AFTER:=srcrange(srcrange.Count), LookIn:=xlValues) '搜尋文字
'After 選擇性的 Variant。指定儲存格，尋找將從該儲存格之後開始。此儲存格對應於從使用者介面尋找時的使用中儲存格位置。
'注意 After 必須是尋找範圍中的單個儲存格。請記住尋找是從該儲存格之後開始的；必須等到該方法循環回到此儲存格時，才會搜尋其內容。
'如果未指定此引數，搜尋將從範圍的左上角儲存格之後開始
End With
If Not fndrange Is Nothing Then
'fstaddress = fndress = fndrange.Address '這裡錯誤讓他無止盡的貼下去
fstaddress = fndrange.Address
i = 3
Do
Cells(i, 1).Value = fndrange.Offset(, 1)
Cells(i, 2).Value = fndrange.Offset(, 2)
Cells(i, 3).Value = fndrange.Offset(, 3)
Cells(i, 4).Value = fndrange.Offset(, 4)
Cells(i, 5).Value = fndrange.Offset(, 5)
Cells(i, 6).Value = fndrange.Offset(, 6)
Cells(i, 7).Value = fndrange.Offset(, 7)
Set fndrange = srcrange.FindNext(AFTER:=fndrange)
i = i + 1
Loop Until fndrange.Address = fstaddress
Else
MsgBox ("沒有資料")
End If
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

TOP